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ABSTRACT 


The object of the research reported herein was to develop a 
general mathematical model and solution methodologies for 
analyzing the structural response of thin, metallic shell 
structures under large transient, cyclic, or static 
thermomechanical loads. Among the system responses associated * 
with these loads and conditions are thermal buckling, creep 
buckling, and ratcheting. Thus geometric and material 
nonlinearities (of high order) can be anticipated and must be 
considered in developing the mathematical model. The methodology 
is demonstrated through different problems of extension, shear 
and of planar curved beam. Moreover, importance of the inclusion 
of large strains is clearly demonstrated, through the chosen 
applications. This report describes the computer program 
resulting from the research. 
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Introduction 

Program PSTBKL is developed to study the thermo-elastoviscoplastic postbuck- 
ling behavior of shell-like structures. The main features of the program include: 

1. Buckling and post buckling predictions of shell-like structures 

2. Response of the structure at elevated temperatures 

3. Creep buckling predictions 

4. Freedom to choose different thermo-mechanical loading path 

5. Bodner-Partom’s constitutive equations as an elastoviscoplastic material model 

6. Walker’s constitutive equations as another elastoviscoplastic material model 

7. Nonlinear elastic calculations 

8. Crisfield’s iteration schemes for limit point load problems 

9. Tanaka- Miller’s method used to integrate the unified constitutive equations 
The program works for material B1900+Hf now. With minor change, it can work 

for other materials. 


Input Format 

File DT is the main input data file. File RD is used only when the program needs 
to resume a unfinished job. File RD can be copied from file WRT which is an output 
file in the last execution. 

The format of file DT is the following: 

(1). Control data (fines 1 through 8) 

Line 1: II, 12, 13, 14 

II — number of elements, 12 — number of nodes, 13 — number of steps planed to run, 
14 — maximum number of iterations allowed in each load step 
Line 2: Al, A2, A3, A4, A5, A6 

A1 — elastic modulus of the material, A2 — Poisson’s ratio, A3 — thickness of the 
structure, A4 — load coefficient (take 1.0), A 5 — load coefficient (take 1.0), A6 — initial 
load step (take 1.0, not use now) 
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Line 3: II, 12, 13 

II — the node number of the output displacement, 12 — the component of the output 
displacement, 13 — the control variable 

Line 4: II, 12, Al, A2 

II — determine whether the execution from the beginning (choose 0) or from the 
last execution (choose 1), 12 — number of loading steps before the program write data 
for further execution, Al— the displacement increment of control variable, A2 — the 
increase rate of Al in next step (take 1.0 generaly) 

Line 5: II, 12, 13, 14, Al, A2, A3, A4 

II — determine whether the thermal expansion is considered (take 1) or not (take 
0), 12 — number of steps for the change of temperature, 13 — number of iterations exe- 
cuted before writing temporary data, 14 — maximum number of iterations allowed in 
the equilibrium iterations, Al — thermal expansion coefficient, A2 — initial tempera- 
ture, A3 — increment of temperature, A 4- — highest temperature 

Line 6: II, 12, Al, A2 

II — option whether to use unified constitutive equations (1 for yes, 0 for no), 12 — 
option of which constitutive model to use (1 for Bodner-Partom’s model and 2 for 

Walker’s model), Al — ■calculation coefficient (take 1.0), A2 — the increment of time in 

* 

a load interval 

Line 7: II, 12 

II — option for creep calculation (1 for yes and 0 for no), 12— number of steps 
beyond which creep is calculated 

Line 8: II, 12 

II and 12 are used to control the output of the calculated results. The value of 11 
can be an integer from 1 to 6 which correspond to the stretch of bar, plate, cylindrical 
shell unter axial compression, cylindrical shell under pressure and cylindrical shell 
under torsion. 12 controls the way of output (see NTV in subroutine OUTPUT). 
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(2). Initial nodal coordinates 
format: II, Al, A2, A3 

II— node number (it. does not matter whatever to write, but the real nodal number 
must in order of 1, 2, 3...), Al — X, A2 — Y, A3- — Z 


(3) . Constraint specification 

format: II, 12, 13, 14, 15, 16 

II — node number, 12 — displacement in x direction, 13- — displacement in y direc- 
tion, 14 — displacement in z direction, 15— rotation along local x axis, 16 — rotation 
along local y axis (0 for free movement and 1 for constraint) 

(4) . Applied load 

format: II, Al, A2, A3, A4, A5 

II — node number, Al — load applied in x direction, A2 — load applied in y di- 
rection, A3 — load applied in z direction, A4 — moment applied in local x direction, 
A 5 — moment applied in local y direction 

(5) . Elment and its corresponded nodes 

format: II, 12, 13, 14, 15, 16, 17, 18, 19 

II — element number, 12 through 19— the node number of the element 

(6) . Direction cosines of the structure 

format: II, Al, A2, A3 

II — element number, Al through A3 — the initial direction cosines of local coordi- 
nates to global coordinates at position of the node 

(7) . Radius and length of the shell 

Output Files 
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The output files are WRT, OUT, OT, OUT1, OT2 and OUT3. Pile ■' WRT contains 
the necessary data for further execution. File OUT is the data used to locate any 
problem occurred during execution. Files OT, OTl, OT2 and 0T3 are output files for 
the calculated results controlled by subroutine OUTPUT. In the subroutine, Dl(I,J) 
is the displacement matrix where I and J are the nodal number and displacement 
component number, respectively. The updated coordinates of node I are XX(I), YY(I) 
and ZZ(I). The corresponding load can be calculated as the product of TROOT (a 
variable in the subroutine), load coefficient and the applied load (given in file DT). 
Files OT, OTl, 0T2 and OT3 are associated with tape 3, 9, 11 and 12. Users can 
change subroutine OUTPUT to get desired output. 

Subroutines from Library 

The subroutine LINRG from software IMSL is called in the program to invert the 
stiffness matrix. The corresponding version in Cyber is LINV3F. 
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Main Flowchart 
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( 1 ). creep calculation 


(2). thermal effects calculation 
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( 1 ). calculation of load and displacement increment 
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Program pstbkl is for the ppstbuckl ing analysis with either 
Bodner-Partom' s or Wal ker 1 s mater i al model. The program can 
C deals with the following problems: 

C 1. Postbuck ling responses of thin-walled structures under 

C normal loading 

C 2. Creep buckling analysis 

C 3* Thermal effects 

C 5 > 5 > ft * *' x C S ? C )*C ii * * ?C >’C * 5*C 5*C & 5*C * & * * * >V 5*C ?’c 1< 5*C 5*C * * it ft * >*C * * * * ?*C * * * V? * * * }V 5’c * A 5*C & & ft & 5*C ft * ft ft * * * ft C 

c 

PROGRAM PSTBKL 
IMPLICIT REAL*8 (A-H , 0-Z) 

IMPLICIT INTEGER*8(I-N) 

PARAMETER (MAXR= 1 50000 , MAXI =5000) 

DIMENSION RWKSP (100000) 

COMMON /PNTRIN/ I PI , I P2, I P3, 1 Pk, I P5 » I P6, I P7, I P8, I P9, 1 P10 
COMMON /PNTRRL/ IR1.IR2, IR3, IR4, IR5. Ift£. IR7, I R8, I R9, I R 10, 

1 I R 1 1 , 1 R 1 2 , 1 R 1 3 , IRU.IR15. IR16, 1 R 1 7 » IR18. 

2 IR19, IR20, IR21, IR22.IR23. lR2k, IR25, IR26, 

3 I R27 » I R2 8 , 1 R29 , IR30, IR31, IR32, IR33. IR3 1 *, 

it I R35 . 1 R36 , 1 R37 , I R38 , 1 R39 . 1 R i»D , I Rlt 1 , 1 R42 , 

5 I Ri»3, t R44, IR45, 1 R46 , IR1*7, 1 R48 , 1 R49. IR50 

COMMON /RLVEC/ VR (MAXR) 

COMMON / I NTVEC/ IPT(MAXI) 

COMMON /WORKSP/ RWKSP 
C 

C If the program is used in cyber, active Ir4l*=lr23 statement. 

C 

OPEN (3, F I LE='ot l ) 

OPEN (1* , F I LE= ' r d 1 ) 

OPEN (5 * F I LE='dt ') 

OPEN (6, F I LE= , out ' ) 

OPEN (7 , F I LE® 1 wrt ' ) 

OPEN (9, F I LE* 1 otl ') 

OPEN (1 1 , F I LE= 1 ot2 1 ) 

OPEN (12, F I LE= 1 ot3') 

C 

CALL CMPT1 
C 

C Call cmptl to make initial memory arangement 
C 

CALL I WK IN (100000) 

C 

C I WK IN Is used to set work space for subroutine LI NRG wich is 
C given in IMSL library. 

C 

CALL PREPC (I PT (I PI) , I PT (I P2) , I PT (1 P3) ,VR(IR1) ,VR(IR2) , 

1 VR ( I R 3) ,VR(IRk) ,VR (IR5) ,VR(IR6) ,VR(IR7)) 

C 

STOP 

END 

C 

C 

C Subroutine PREPC is used to read input data and make memory 
C arragement 

C 

SUBROUT I NE PREPC ( I EL , I D , I I D , XX , YY , ZZ , DD 1 , DD2 , DLOAD , HOR I Z) 
IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION IEL(NELM,8) , I D ( 1 ) , I ID (NN0DE,5) ,XX(1) , YY (1) ,ZZ(1) , 

1 DD1 (1) ,002 (1) , DLOAD (!) ,H0RIZ(1) 

C 

COMMON /SCHALR1/ NELM.NNODE ,NT 

COMMON /SCHALR2/ NEQT, NSTEP , NHBW, COEF 1 , COEF 2 , NSH0W1 ,NSH0W2, 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 P3, IP4, 1 P5, 1 P6, I P7, 1 P8, 1 P9, 1 P10 
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COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, I R7 • t R8 , 1 R9 » I R 1 0 » 

1 I R 1 1 , I R12, I R13, I R 1 -4 • I R 1 5 * IR16, IR17. lRl8, 

2 IR19, IR20, IR21 , IR22, IR23, IR24, IR25. IR26, 

3 IR27, IR28, IR29, IR30, IR31 , I R32 , I R33» I R3^, 

4 IR35.IR36.IR37. IR38* IR39, IR40, IR41 , IR42, 

5 I R43, IR44, IRJ*5, IR46,IR47,IR48,IR49,IR50 

COMMON /UN I F BD/ I R5 1 , l R52 , 1 R53 . 1 R54 . I R55 . I R56 .IR57.IR58.IR59 
COMMON /DIRCS/ IR60, IR6l , IR62, IR63, I R64 , I R&5 
COMMON /DISV1/ IR70, IR71 , IR72, IR73. IR7 1 *, IR75 

COMMON /UNICT/ NCONS .MODEL , ETAA ,TDELT,T I N I T 
COMMON /RLVEC/ VR(1) 

COMMON /INTVEC/ IPT(1) 

CALL GETDT (I PT (I PI) , I PT (IP2) , I PT (IP3) , IPT (I P4) , IPT(IP5) , 

1 I PT (I P6) , I PT (I P7) , IPT(IP8) ,VR(IR1) ,VR(IR2) ,VR(IR3) , 

2 VR(IRlf) ,VR (IR5) ) 

Call GETDT to read data. Call CMPT2 to make memory arrangement. 

Call RDSUP to get further data input. 

CALL CMPT2 

CALL RDSUP(VR(IR60) ,VR(IR61) ,VR(IR62) ,VR(IR63) ,VR(IR64) ,VR(IR65) , 

1 VR (IR75) ) 

CALL PROCS (VR (I R6) ,VR (IR4) ,VR (I R5) , VR ( I R9) ,VR(IR27) ,VR(IR20) , 

1 VR(IR43) , VR(IR44) ,VR(IR45) , VR ( I R l ) ,VR(!R2) ,VR(IR3) , 

1 VR(IR47) , VR ( I R42) .VR(IRIO) ,VR(IR51) ,VR(IR58) ,VR(IR39)) 

CLOSE (3) 

CLOSE (4) 

CLOSE (5) 

CLOSE (6) 

CLOSE (7) 

CLOSE (9) 

CLOSE (11) 

CLOSE (12) 

RETURN 

END 

Subroutine procs is used to arrange the loading scheme, so that 
the normal loading, creep and temperature effects can be considered 
either simultaneously or separately. 

SUBROUT I NE PROCS (DLOAD , DD 1 , DD2 , PLD , ACMD I S, SI GMA , XX 1 , YY 1 , ZZ 1 , 

1 XX , YY , ZZ , UPS I G , FRC I NC, FRCO , BETA , UPBET , EM) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION DLOAD (1) , DD 1 (1) ,DD2(1) ,PLD(1) , ACMD I S (1) , 

1 SIGMA (NELM.2,2,2, 9) ,XX(1) , YY (F) , ZZ (1) ,XX1 (1) ,YY1 (1) , 

2 ZZ1 (1) , UPSIG (NELM.2,2,2,9) .FRCINC(l) ,FRCO(l) , 

3 BETA (NELM, 2, 2 , 2, 1 2) .UPBET (NELM.2,2,2, 12) ,EM(6,6) 


COMMON /SCHALR1/ NELM.NNODE.NT 

COMMON /SCHALR2/ NEQT , NSTEP , NHBW, COE FI , C0EF2.NSH0W1 » NSHOW2 , 

I NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRIN/ IP1 , IP2, IP3, IP4, IP5, IP6, IP7, IP8, IP9, IPIO 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5. IR6, IR7.IR8, IR9, IRIO, 

I IR11, IR12.IR13, IRl4j.IR15.IRl6, IR17. IR18, 

l I R 1 9 , I R20 , I R2 1 , I R22 , I R23 . I R24 , IR25 , I R26, 

3 IR27.IR28.IR29, IR30, IR31 , IR32, IR33, iR34, 

♦ IR35, IR36, IR37, IR38, IR39, IR40, IR41 , IR42, 

3 IR43,IR44,IR45,IR46,IR47, IR48,IR49,IR50 

COMMON /UNIFBD/ I R5 1 , I R52, I R53, I R54 , I R55, I R56, I R57 , I R58, I R59 
COMMON /DIRCS/ IR60, IR 6 l , IR62, IR63. IR64, IR 65 
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COMMON /D I SVC/ IR66, IR 67 , 1 R68, IR 69 
COMMON /DISV1/ IR70, IR71,lR72,lR73,IR7 i »JR75 
COMMON /UNICT/ NCONS, MODEL, ETAA,TDELT,TINIT 
COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT , DTLAM, SGN , I PP ,TROOT , ASO , SP 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ I NS I DT , KPDT , DTLM 1 

COMMON /ABDFST/ I SEC 

COMMON /SQ/ SQQ 

COMMON /NMBITR/ NUM 

COMMON /DISCT/ NDC.NDBC 

COMMON /CREEP/ ICRP,NBCRP,NBDN,CRPTM, IPON 

COMMON /TMPEF/ I DO.NTEM.N ITR.NANM, CEXPN.TMMI N.TMI NC.TMMAX.TMPP 

C 

DO 10 1=1, NNODE 
XXI (I ) =XX (I) 

YY1 (I) =YY (I) 

ZZ1 (l)=ZZ(l) 

10 CONTINUE 
C 

IF (INSIDT.EQ. 1) THEN 

C If the execution is based on the previous calculation, get 

C additional information 

CALL RDCDT (VR ( I R2 7) ,VR(IR20) ,VR ( IRl*3) , VR ( I Rif 4) ,VR(IRl»5) , 

1 VR(IRl) , VR (I R2) ,VR(IR3) ,VR(IRl*7) , VR ( I R 1 0) , 

2 VR (TR51) , VR ( I R 58 ) , VR ( I R 60 ) ,VR(IR 6 l) ,VR(IR62) , 

3 VR ( I R 63 ) , VR ( I RGk) , VR { I R65) , VR ( I R 1 5) , VR ( I R7 1 ) , 

4 VR (IR75) ) 

END IF 

C 

DO 200 J= 1 , NT 

DLOAD(J) =DD1 (J) *COEF 1 
200 CONTINUE 
R00T=0 .0 
D.TLAM=F ACTOR 
R00T=R00T +DTL AM 
SGN=1 .0 
I SEC*' ! 

C 

C Calculate material constants according to the chosen model 
C 

I F (I DO.EQ.O) THEN 
TMPP=TMMI N 
IF (NCONS.EQ.O) THEN 

E= 198700. 0+1 6 . 78*TMPP-0 . 1 03^**TMPP*TMPP 
1 +0 . 00001 1 1»3*TMPP*TMPP*TMPP 

ELSE 

IF (MODEL. EQ.l) CALL BDCNS (TMPP) 

IF (MODEL. EQ. 2) CALL WKCNS (TMPP) 

END IF 
END IF 
C 

C Calculate the elastic matrix 
C 

CALL ELSMTR (EM) 

C 

C 

DO 220 J= 1 , NT 

DLOAD (J) =*DD2 (J) *C0EF2 
PLD (J)=0.0 
220 CONTINUE 
C 

C Next iteration is to calculate the thermal effect 
C 

IF ( I DO .EQ. 1) THEN 


10 



DO 205 1=1 ,NTEM 
NUM= I 

TMPP=TM I NC+TMPP 
IF (NCONS.EQ.O) THEN 

E= 1 98700 . 0+ 1 6 . 78*TMPP-0 . 1 034*TMPP*TMPP 
1 +0 . 0000 1 1 43*TMPP*TMPP*TMPP 

ELSE 

IF (MODEL. EQ.l) CALL BDCNS (TMPP) 

I F (MODEL. EQ. 2) CALL WKCNS (TMPP) 

END IF 
C 

IF (TMPP.GT.TMMAX) THEN 

WRITE (6,*) 'THE MAXIMAM LIMIT OF TEMPERATURE IS REACHED, STOP' 
STOP 
END IF 
C 

CALL THRML (I , IPT(IPl) , IPT(IP2) , IPT(IP3) , I PT ( I P4) , IPT(IP5) , 

1 IPT(IP9) ,VR(IR1) , VR ( I R2) ,VR(IR3) ,VR(IR6) ,VR(IR8) * 

2 VR(IR9) ,VR(IR10) ,VR(IR11) , VR (I R1 2) ,VR(IR13) ,VR(IR14) , 

3 VR (IR15) , VR ( I R 1 6) , VR ( I R1 7) ,VR(IR21) ,VR(IR22) ,VR(IR23) , 

4 VR ( I R24) , VR (IR18) ,VR(IR26) ,VR(IR27) ,VR(IR42) ,VR(IR43) , 

5 VR (I R44) , VR ( I R45) ,VR(IR46) ,VR(IR47) ,VR(IR20) ,VR(IR48) , 

6 VR ( I R49) , VR ( I R 1 9 ) , VR ( I R 50 ) , VR ( I R5 1 ) , VR ( I R 58 ) , VR ( I R 59 ) , 

7 VR ( I R60) , VR ( I R6 1 ) , VR (I R62) , VR ( I R 63 ) , VR ( I R&4) , VR ( I R 65 ) , 

8 VR ( I R4) ) 

205 CONTINUE 

END IF 
C 

C Next iteration is to calculate creep responses (with or without 
C thermal effects) or the normal loading responses (with or withour 
C thermal effects) 

C 

DO 900 1=1 ,NSTEP 
R00T=0.0 
NUM= I 

IF (NBDN.GT.NBCRP.AND. ICRP.EQ. 1) THEN 

CALL NTCRP (I , IPT(IPl) , I PT (I P2) , I PT ( I P3) , IPT(IP4) , IPT(IP5) , 

1 I PT ( I P9) , VR ( I R 1 ) , VR (IR2) , VR { I R3) ,VR(IR6) ,VR(IR8) , 

2 VR (IR9) , VR (IR10) , VR (IR1 1) , VR (I R1 2) , VR ( I R1 3) ,VR(IR14) , 

3 VR ( I R 1 5) » VR ( I R 1 6) , VR (I RI 7 ) , VR (IR21) ,VR(IR22) ,VR(IR23) , 

4 VR (IR24) , VR ( I R 1 8) ,VR(IR26) , VR ( I R27) ,VR(IR42) ,VR(IR43) , 

5 VR { I R44) , VR ( I R45) , VR ( I R46) , VR ( I R47) , VR ( I R20) , VR ( I R48) , 

6 VR ( I R49) ,VR ( I R 1 9) , VR (I R50) , VR ( I R51) , VR (I R 58 ) ,VR( IR59) , 

7 VR(IR 60 ) ,VR (I R6l) ,VR (I R62) ,VR(IR63) ,VR(IR64) ,VR(IR65) , 

8 VR (IR66) , VR ( I R 67 ) , VR (IR68) ,VR(IR69) ,VR (IR 71 ) ,VR (IR 72 ) , 

9 VR (IR73) ,VR(IR75) , VR(IR74)) 

ELSE 

CALL ARCLS (I , I PT (I PI) , I PT ( I P 2 ) , I PT (I P3) . I PT ( I P4) , I PT ( I P5) , 

1 I PT ( I P9) , VR ( I R 1 ) , VR (I R2) , VR ( IR3) , VR ( I R6) , VR (I R8) , 

2 VR ( I R9) , VR ( I R 1 0) , VR ( I R 1 1 ) , VR (1 R1 2) , VR ( 1 R 1 3) . VR ( I R 1 4) , 

3 VR ( I R 1 5) , VR ( I R 1 6) , VR ( I R 1 7) , VR ( I R21) , VR ( IR22) , VR ( I R2 3) , 

4 VR (I R24) , VR ( I R 1 8) * VR ( I R26) , VR ( I R2?) , VR (IR42) ,VR (I R43) , 

5 VR ( I R44) , VR ( I R45) , VR ( I R46) , VR ( I R47) , VR ( I R20) , VR ( I R48) , 

6 VR(IR49) ,VR(IR19) .VR (IR50) »VR(IR51) ,VR (IR 58 ) ,VR (IR59) , 

7 VR (IR 60 ) , VR ( I R 6 1 ) ,VR ( I R 62 ) ,VR (IR 63 ) ,VR (IR64) ,VR{lR65) , 

8 VR (IR66) ,VR(IR67) ,VR(IR68) ,VR(IR69) ,VR(IR71) ,VR(IR72) , 

9 VR(IR73) ,VR(IR75) ,VR(IR74)) 

C 

END IF 

I F (I D0.EQ.2) THEN 
TMPP=TM I NC+TMPP 
IF (NCONS.EQ.O) THEN 

E= 1 98700 . 0+ 1 6 . 78*TMPP-0 . 1 034*TMPP*TMPP 
1 +0.00001 143*TMPP*TMPP*TMPP 

ELSE 

IF (MODEL. EQ.l) CALL BDCNS (TMPP) 
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IF (MODEL. EQ. 2) CALL WKCNS (TMPP) 

END IF 

CALL THRML (I , I PT ( I PI) , I PT ( I P2) , I PT (I P3) , I PT (I P4) , I PT (I P5) , 

1 I PT (I P9) , VR ( I R 1 ) ,VR (IR2) , VR ( I R 3) ,VR(IR6) ,VR(IR8) , 

2 VR(IR9) , VR (IRIO) , VR ( I R 1 1 ) ,VR(IR12) , VR (IRT3) , VR ( I R1 4) , 

3 VR (I R15) ,VR(IR16) , VR ( I R 1 7) * VR ( I R2 1 ) ,VR(IR22) ,VR(IR23) , 

4 VR ( I R2 4) , VR ( I R 1 8) ,VR(IR 26 ) , VR (I R27) ,VR(IR42) ,VR(IR43) , 

5 VR ( I R44) , VR ( I R45) , VR ( I R46) , VR ( I R47) ,VR ( I R20) , VR ( I R48) , 

6 VR ( I R49) , VR ( I R 1 9) , VR ( I R§0) , VR ( I R5 1 ) , VR (I R$8) . VR ( I R59) , 

7 VR ( I R60) ,VR (IR6l) *VR (IR 62 ) , VR ( I R63) ,VR(IR64) ,VR(IR65) , 

9 VR ( I R4) ) 

DO 221 J=1 ,NT 

DLOAD (J) =DD2 (J) *COEF2 
PLD (J) =0.0 
221 CONTINUE 
END IF 

900 CONTINUE 

C 

RETURN 

END 


Subroutine ARCLS is used for normal loading calculation. 
Arc-length method is used in the iteration scheme. 


C 


C 


1 

2 

3 

4 
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SUBROUTINE ARCLS (INUM, I EL, ID, I I D, L.MAXA, LD, XX, YY , ZZ, DLOADT, D , 

PLD , FRCO, DD , DLDINC , VTEMP, VF , D1 , VFE , DDD, AM, PD, 

P, A.TDLD ,H I S I NC, ACMD I S , FRC I NC.XXl , YY1 , ZZ1 , DELTA, 
UPS I G , S I GMA.DLTI NC, DLTTMP.STI FFN, EXLVC, BETA, UPBET, 
ACTFRC.GCLl ,GCL2,GCL3.UCL1,UCL2,UCL3,ADC,ADD,AD, 
ADVC ,TLTY ,TY1 ,TY2 , ANGL , DBVC) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT I NTEGER*8 ( I -N) 


DIMENSION I EL (NELM, 8) ,ID(1) ,1 ID(NN0DE,5) ,L(1) ,MAXA(1) ,LD(1) 
DIMENSION XX (1) , YY ( 1 ) , ZZ (1) , DD (NNODE ,5) , D (1) ,PLD(1) , 

1 DLOADT (1) .DLDINC (1) ,VTEMP(1) ,VF (NNODE, 5) , 

2 D1 (NNODE, 5) , VFE (NT,1) , DDD (1) ,VRT(4) , 

3 A (NEQT, NEQT) , AM (40, 40) , PD (1) ,TDLD (1) , 

4 HIS INC (1) , ACMD IS (1) .FRCINC (1) ,XX1 (1) ,YY1 (1) ,ZZ1 (1) , 

5 DELTA (1) , FRCO ( 1 ) , UPS I G (NELM, 2 , 2 , 2 , 9) ,ACTFRC(1) , 

6 SIGMA (NELM, 2, 2, 2, 9) .DLTINC(l) , DLTTMP (1) , COEEQ (5) , 

7 DEFVRT (4) , ST I FFN (NT, NT) ,ETT(4) .EXLVC (1) , 

8 BETA (NELM, 2, 2, 2, 12) .UPBET (NELM, 2 , 2, 2, 1 2) ,GCL1 (NNODE, 3) , 

9 GCL2 (NNODE, 3) ,GCL3 (NNODE , 3) ,UCL1 (NNODE, 3) , 

1 UCL2 (NNODE, 3) .UCL3 (NNODE, 3) ,ADC (NDBC.NDBC) , 

2 ADD (NDBC, NEQT) , AD (NEQT.NDBC) ,ADVC(1) ,TLTY (1) ,TY1 (1) , 

3 TY2(1) , ANGL (1) , DBVC (1) 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT,NSTEP,NHBW»C0EF1 .C0EF2.NSH0W1 ,NSH0W2, 

1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTR1N/ I PI , I P2 , 1 P3, 1 P4, 1 P5, 1 P6, 1 P7, 1 P8* I P9, 1 P10 
COMMON /PNTRRL/ I R1 , 1 R2 , 1 R3, IR4, 1 R5, 1 R6, 1 R7, 1 R8, 1 R9, I RIO, 

1 IR11, IR12, IR13, IR14.1R15, IR16, IR17, IR18, 

2 IR19, IR20, IR21 , IR22, IR23, IR24, IR25, IR26, 

3 IR27, IR28, IR29, IR30, IR31 , I R32, IR33, IR34, 

4 IR35, IR36, IR37, IR38, IR39, IR40, IR41 , I R42, 

5 IR43.IR44.IR45, IR46.IR47, IR48, IR49, IR50 
COMMON /UNIFBD/ IR51 , IR52, IR53, IR54, IR55, IR56, I R57VIR58, IR59 
COMMON /DIRCS/ IR60, (RSI , IR62, IR63, IR64, IR65 

COMMON /DISCT/ NDC.NDBC 

COMMON /D I SVC/ IR 66 , IR&7, 1 R 68 , IR 69 

COMMON /DISV1/ IR70,IR71,IR72,IR73,IR74,IR75 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
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Begin iteration 


I I 1 = 1 

r 

CALL MNU(NN0DE,5,VF) 

DO 200 1=1, NT 

DLD I NC (1) =DL0ADT (1) 

200 CONTINUE 

r 

DO 195 1=1 , ND 
TDLD (l)=0.0 
HIS INC (I) =0.0 
195 CONTINUE 

210 FORMAT (' I ,LD INC, LOADT.PLD I S' , 1 I 3, 3F8.3) 

579 CONTINUE 
C 

C Call ASSMBL is to form the stiffeness matrix 

C 

CALL ASSMBL ( 1 I I , I PT ( I P 1 ) , I PT ( I P2) , I PT (I P3) , I PT (I P4) , 1 PT ( I P5) , 

1 IPT(IP9) , VR (IR1) , VR (I R2) ,VR(IR3) ,VR(IR6) ,VR(IR8) , 

2 VR (I R12) ,VR(IR14) ,VR (IR15) ,VR ( 1 R 1 6 ) ,VR(IR19) ,VR(IR21) , 

3 VR ( I R23) ,VR (IR24) ,VR(IR19) , VR ( I R4 1 ) ,VR(IR50) ,VR(IR52) , 

4 VR ( I R66) , VR ( I R67) , VR (I R68) , VR ( I R74) ) 

C ' 

c 

I CDD=1 

IF (I I I . GT . 2) GOTO 577 
IF (NDC.EQ. 1) THEN 

C For displacement boundary value problem, calculate ADVC 

CALL D I SBN (VR ( I R69) , VR ( I R75) ) 

DO 570 1=1 ,ND 
ODD (I) =0.0 
DO 570 J=1 , NDBC 

DDD ( I ) =DDD ( I ) +AD ( I , J) *ADVC ( J) 

570 CONTINUE 

533 FORMAT (1 I 3»6F9.3) 

DO 572 1=1, ND 

DDD (I ) =D (I) -ODD (I) 

572 CONTINUE 
END IF 

I F (NDC.EQ. 0) THEN 
DO 573 1=1, ND 
DDD (l)=D (!) 

573 CONTINUE 
END IF 

16 F ORMAT ( 1 D ( I ) AND DDD ( I) : * ,1 1 3.2F 14.5) 

C 

577 CONTINUE 

WRITE (6,36) M l 

36 F ORMAT ('THIS IS THE ITERATION ',113) 

IF (III .EQ. ITRLM) THEN 

WRITE (6,*) 'ITERATION LIMIT REACHED. STOP.' 

STOP 
END IF 
C 

IF (I I I .EQ. 1) THEN 
DO 444 1 = 1, ND 
DO kkh J=1 ,ND 

TDLD ( I ) =TDLD (I ) +A (I , J) *DDD (J) 

444 CONTINUE 
C 

DO 755 1=1, ND 
VTEMP (I) =0.0 
DO 755 J=1,ND 

VTEMP ( I ) = VTEMP ( I ) +ST I F FN ( I , J) *TDLD (J) 

755 CONTINUE 
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ASL=0.0 
DO 857 1=1, ND 

ASL=ASL+VTEMP { I ) *TDLD ( I ) 

357 CONTINUE 

WRITE (6,*) 'ASL 1 , ASJU 

ETA=1 .0 

C Next statement is important. It determines the controvar iable. 

r 

FAC=DTLM1/ABS (TDLD (NSH0W3) ) 
r FAC=DTLM1/ABS (TDLD (ND-NSH0W3) ) 

WRITE (6,*) ' TDELT=' ,TDELT 
IF (ASL. LT. 0.0) THEN 
FAC=-FAC 

WRITE (6,*) 'CHANGED SIGN OF FAC 
END IF 

IF (DETMNT.LT. 0.0) WRITE (6,*) 'NEC. DET. STOP 1 
IF (DETMNT.GT.O.O) FAC=ABS (FAC) 

DO 550 1=1, ND 
DLTTMP ( I ) =0 .0 
D E LT A ( I ) =0 . 0 
VTEMP ( I ) =0 .0 
FRCINC (l)=0.0 
550 CONTINUE 
END IF 
C 

C Finish i i i=l calculation. 

C Next to calculate the start point di splasment HIS INC (I ) 

C 

C 

C ACCELERATION COMPUTATION 

C 

IF ((I I I .EQ.l) .OR. (I I I .EQ.2)) GOTO 624 
D55=D5 
D66=D6 
D77=D7 
El 1=E1 
E22=E2 
C 

C Prepare the coefficients of the equation which determines the 

C load parameter, 

C 

CALL CALCDT (ND.DTL, ROOT, FAC, Cl, C.2., Dll, .02,03.04, 05. D6,:D7,AV, 

1 VR (I R18) , VR ( I R 1 7) , VR (I R26) ,VR(IR46) ,VR(IR42)) 

C 

ETAO=ETA 

ROOTO=ROOT 

KK=0 

C 

RTL=ROOT 

WRITE (6,*) 1 RTL=‘ ,RTL 
C Calculate the root of the equation 

CALL CLCRT (ETAO , ETA , ATERM, C 1 , D 1 1 , D2 , 03 , D4 , A4 , DTL , ROOT) 

ETA=1 .0 
624 CONTINUE 

No acceleration iteration 
IF ((I I I .EQ.l) .OR. (I I I .EQ.2)) THEN 

For first and second iterations, there is no acceleration calculation 


ETA=1 .0 

CALL CALCDT(ND,DTL,R00T,FAC,C1,C2,D11,D2,D3,D4,D5,D6,D7,A4, 
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VR ( I R 1 8) , VR ( I R 1 7) ,VR(IR26) ,VR(IR46) ,VR ( I R42) > 


IF (I I I . EQ. 1) GOTO 625 

CALL CLCRT(ETA0,ETA,ATERM,C1,D1 1,D2,D3,D4,A4,DTL,R00T) 
END IF 

WRITE (6,*) 'Ill-Mil 


C 

c 

c 


625 


634 


635 


C 

C 

C 

C 

C 

C 

C 

C 

C 


C 

c 


580 

586 


901 

302 


CONTINUE 


Calcula te the d i sp 1 acement i ncr ement 


DO 635 1=1, ND 
DLTINC (I) =0.0 
IF(lil.EQ.l) THEN 
IF (NCONS.EQ.l) THEN 
DO 634 J-l.ND 

DLT I NC (I ) pO.LT INC (l)+A (I , J) *EXLVC (J) 
CONTINUE 

DLTINC (l)-FAC*TDLD (D+DLTINC (!) 

ELSE 

DLTINC (l)=FAC*TDLD(l) 

END IF 
ROOT=FAC 
ELSE 

DLTINC (I) -ETA* (H I S I NC ( I ) +ROOT*TDLD ( I ) ) 
END IF 


DELTA ( I ) =D LTTMP ( I ) +D LT I NC (I ) 

CONTINUE 

IF (III .EQ. 1) THEN 

WRITE (6,*) 'FIRST ITERATION OF STEP '.NUM 
END IF 


I =NEQT 

WRITE (6,*) 'CURRENT ROOT '.ROOT 
WRITE (6,*) 'TDLD (25) '.TDLD(I) 

WRITE (6,*) I,' ROOT*TDLD ' ,R00T*TDLD (I) 
WRITE (6,*) I,' FRCINC ' , FRC I NC ( I ) 
WRITE (6,*) I,' HIS INC '.HISINC(I) 

WRITE (6,*) I,' DLTINC ' , DLT I NC ( I ) 

WRITE (6,*) I,' DELTA '.DELTA (I) 


K=1 

KK-1 

DO 580 I-1.NN0DE 
DO 580 J-1,5 

IF (I I D (I , J) .EQ.O) THEN 
VF ( I .J) -DLTINC(K) 

DD (I ,J) -DLTINC (K) 

K-K+l 
END IF 

IF (I ID (I ,J) . EQ.2) THEN 
VF (I , J)= (ROOT-RTL) *ADVC (KK) 
DD (I , J) -VF (I ,J) 

KK-KK+1 
END IF 
CONTINUE 

FORMAT (1 1 3.5F 12.8) 


DO 901 1=1 .NNODE 
DO 901 J-1,5 

VFE (l*5-5+J,l)=VF (I ,J) 

CONTINUE 

FORMAT (' I, VFE (!) IS: ',212,1 F 12.6) 


C 

C 


Estimation of the new coordinates 
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T i NC=1 .0 


Update the coordinates 

DO 900 1=1 ,NN0DE 

XX (l)=XX (l)+TINC*DD (I , 1) 

YY(I)=YY(I)+TINC*DD(I ,2) 

ZZ ( I } =ZZ ( I ) +T.I NC*DD (I ,3) 

TMP=0 .0 
DO 903 J=1 , 3 

GCL3 ( I , J) =GCL3 (I , J) +T I NC* (-GCL2 (I , J) *DD (1 ,4) +G.C.L1 (I , J) *DD (1,5)) 
TMP=TMP+GCL3(I ,J) *GCL3(I ,J) 

903 CONTINUE 

TMP=TMP**0.5 
DO 902 J-1,3 
GCL3 (I ,J)=GCL3 (I , J) /TMP 
902 CONTINUE 

WRITE (6,267) I , XX ( I ) , YY (I ) ,ZZ(I) 

900 CONTINUE 


Update the directional cosines 
CALL CNND(VR(IR 60 ) ,VR(IR6l) ,VR(IR62)) 

Calculate internal forces 

CALL I NTFRC (I I I , IPT(IPl) ,VR(IR1) ,VR(lR2) ,VR(IR3) , 
1 VR ( I R 1 k) , VR ( I R22) , VR ( I R28) , VR ( 1 R9) ) 

SHRINK THE INTERNAL FORCE VECTOR 

DO 500 1=1, NT 
DO 500 M=1 , ND 

IF (I .EQ.L(M)) THEN 

FRC I NC (M) = (PLD ( I ) -FRCO (M) ) 

ACTFRC (M) =PLD (I) 

END IF 
500 CONTINUE 


DO kkl 1=1, ND 
H I S I NC ( I ) =0.0 
kbl CONTINUE 

DO bk8 1=1, ND 
DO kkS J=1 ,ND 

H I S I NC (I) =H I S I NC ( I ) -A (I , J) *FRC I NC (J) 
bbS CONTINUE 

WRITE (6,*) I, 1 Hi S I NC=‘ ,H I S INC (I) 
bh 8 CONTINUE 

DO 5b9 1=1, ND 
EXLVC (I) =0.0 
TDLD (I) =0.0 
DO if 1*6 J=1 ,ND 

TDLD ( I ) =TDLD ( I ) +A ( I , J) *DDD (J) 

1*1*6 CONTINUE 

5b9 CONTINUE 

Check whether to step out of the iterations 

I SWTCH=0 
I SEC= I SEC+1 

IF (I SEC.GT. 10) I SEC=10 
C WRITE (6,*) '|, ODD ( I ) , ROOT*DDD(l) , FRC INC (I), EXLVC (I) * 
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DO 665 1=1, ND 

DLTTMP (I ) “DELTA (I) 

ACMD I S ( I ) -ACMD IS ( I ) +DLT I NC ( I ) 

C WRITE (6,*) I,' ACMD I S ' , ACMD I S (I ) 

665 CONTINUE 
C 

K-l 

DO 585 1=1 ,NNODE 
DO 585 J=1 ,5 

IF (I ID (I ,J) . EQ.O) THEN 
D1 (I , J) =ACMD I S (K) 

K-K+l 
END IF 
585 CONTINUE 
C 

CALL CRITR1 (I I I ,ND,VR(IR8) ,VR ( I R42) ,VR (IR59) , VR (I R1 7) , 
1 VLINIT, ICNC1 ,VALS) 

WRITE (6,*) 'VLINIT-' .VLINIT 
C I F (ICNC1.EQ.O) THEN 

C IFdll.EQ. 1) VLS1-VALS 

C IF (I I I .EQ.2) VLS2-VALS 

C IF (I II .GT.2) THEN 

C IF (VALS. GT. VLSI .AND. VALS.GT.VLS2) THEN 

C WRITE (6,*) ' BREAK-', LIM 

C DTLM1 -DTLM1 /2 .0 

C LIM-LIM+1 

C I F (LIM.EQ.20) THEN 

C WRITE (6, *) 'Break limit reached, stop' 

C STOP 

C END IF 

C GOTO 1000 

C ELSE 

C VLS1-VLS2 

C VLS2-VALS 

C L I M-0 

C END IF 

C END IF 

C END I F 

C 

IF ((ICONCL.EQ.l) .OR. (I CNC 1 . EQ. 1) ) THEN 
C IF (I I I .LT. 3 - AND.NUM.lt. 2k) DTLM1=DTLM1*SQQ 

DTLM1-DTLM1*SQQ 

C IF (I I I . L E . k) DTLM1-DTLM1*! . 1 

IF (I I I .GE.8.AND. I I I .LT.10) DTLM1-DTLM1 /1 . 1 
IF (1 1.1 .GE. 10. AND. I I I .LT. 15 ) DTLM1-DTLM1/1 .2 
IF (I I I .GE . 15) DTLM1-DTLM 1/1.0 

WR I TE (6 , *) 'FIN VAL OF III-', III,' NDTLM1-' , DTLM1 
TROOT-TROOT+ROOT 
C 

C For displacement boundary problem: 

C 

IF (NDC.EQ.l) THEN 
kk = 1 

DO 590 l-l.NNODE 

do 590 J-1,5 

IF (I I D (I , J) .EQ.2) THEN 
D 1 ( I , J) =D 1 ( I , J) +ROOT*ADVC (KK) 

KK-KK+1 
END IF 

590 CONTINUE 
DO 599 1=1,20 

WRITE (6,*) I,' D 1 — ' , (D 1 (1 , J) , J-1,5) 

599 CONTINUE 

C CALCULATE BOUNDARY TRACTION 
TTLD-O.O 
DO 636 l-l.NDBC 
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637 


TY1 (i)=0.0 
TY2 (l)=0.0 
DO 637 J=1,ND 

TY1 ( I ) =TY 1 (l)+ADD (I , J) *DELTA (J) 

CONTINUE 
DO 638 J=1,NDBC 

TY2 ( I ) =TY2 ( I ) +ADC ( I , J) *ADVC (J) *ROOT 
638 CONTINUE 

TLTY ( I ) =TLTY (l)+TY1 (I ) +TY2 (I ) -DBVC ( I ) 

C WRITE (6,*) I,' TLTY=',TLTY(I) 

TTLD=TTLD+TLTY (I) 

WRITE (6,*) I,' TY1 = ' ,TY1 (I) , ' TY2=' ,TY2 (I) , ' TLTY=* ,TLTY (l) 

036 CONT I NUE 

WRITE (6,*) 'TTLD-'.TTLD 
END I F 


CRPTM=CRPTM+TDELT 

For a sucsessful iteration, write the output data. 

CALL OUTPUT (TTLD,VR{ I R15) ,VR(IR75) ,VR(IR71) ,VR(IR1) ,VR(IR2) , 
1 VR ( I R3) ) 

I TYPE=1 

For successful iteration, update some variables, 

CALL UPDT { I TYPE , I PT ( I P 3) ,VR(IR1) ,VR(IR2) ,VR(IR3) ,VR(IR12) , 

1 VR ( I R15) , VR (I R27) ,VR(IR1*3) ,VR(IRU) ,VR(IRl*5) , 

2 VR(IR1*6) ,VR(IR1»7) , VR ( I R20) ,VR(IR48) ,VR(IRl»9) , 

3 VR ( I R5 1 ) ,VR(IR58) ,VR(IR60) ,VR(IR6l) ,VR(IR62) , 

h VR (IR 63 ) ,VR(IR6A) ,VR(IR65) , VR ( I R75) ) 

ELSE 

If the iteration requiment is not satisfied, calculate the 
following coefficients and go back to the iterations again. 

111=11 1+1 
E 1=0.0 
E2=0.0 

DO 510 1=1, ND 

E1=E1+HISINC(I)*FRCINC(I) 

E2=E2+TDLD ( I ) *FRC I NC (I ) 

510 CONTINUE 

I CDD=I CDD+1 
t F (I CDD.GT.it) THEN 
GOTO 579 
ELSE 

GOTO 577 
END IF 
END IF 

670 CONTINUE 

DO 555 1=1 , ND 
DO 555 J=1 ,ND 

VTEMP ( I ) =VTEMP ( I ) +ST I F FN ( I , J) *DELTA ( J) 

IF(I.EQ.J) THEN 

WRITE (6,*) 'STIFFN2 1 , ST I FFN (I , J) 

END IF 

555 CONTINUE 
C 

ASL0P=0.0 
DO 557 1=1, ND 

ASLOP=ASLOP+VTEMP ( I ) *DELTA ( I ) 

557 CONTINUE 
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ASlOP=A$LOP/ABS (ASLOP) 

IF (NUn.EQ. i) ASO=ASLOP/ROOT /ROOT 
AS I = A S L 0 P / R 00 T/ ROOT 
WR i T? (6 . *) : NUh ! ,NUM 
WRITE (6,*) ’ A SO-, AS I ' , ASO, ASI 
SP=ASC/AS : 

C WRITE (6.*) ‘SP ‘.SP 


DO 730 1=1 , ND 

FRCO (l)=FRCO (D+FRCINC (I) 

730 CONTINUE 

IF (KPDT » EQ.NUM) THEN 

C 

If the required number of iterations has reached, save the 
C nessisary data in harddisk. It can be used for further caiculation. 

C 

CALL WTCDT (VR(IR27) ,VR(IR20) ,VR(IRi»3) ,VR(IR44) , 

1 VR(IRi*5) , VR ( I R 1 ) , VR (IR2) ,VR(IR3) , 

1 VR(IR47) , VR (I RIO) , VR < I R5 1 ) ,VR(IR58) ,VR(IR 60 ) , 

3 VR (I R6l) ,VR(IR62) ,VR(IR15) ,VR(IR71) ,VR (IR75) ) 

END IF 
1000 CONTINUE 
RETURN 
END 

END ARCLS 


Subroutine CALCDT is used to calculate the coefficients of 
the equation which determines the load parameter 


SUBROUTI NE C ALCDT (ND , DTL , ROOT , F AC , C i , C2 , D 1 1 , D2 , D3 , D4 , D5 , D6 , 07 , 

1 A4.TDLD , D , H I S I NC, DELTA, FRC I NC) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT I NTEGER*8 ( I -N) 

DIMENSION TDLD(l) , D (1) ,H I S I NC (1) .DELTA (1) , FRC I NC (1) 

COMMON /SCHALR1/ NELM,NNODE,NT 

COMMON /SCHALR2/ NEQT, NSTEP, NHBW, COEF 1 , C0EF2 , NSH0W1 , NSH0W2 , 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ IP1.IP2, IP3, IP4, IP5.IP6, I P7, I P8, 1 P9 , I P 1 0 
COMMON /PNTRRL/ IR1, IR2, IR3, IR 1 * JR5. IR6, I R7 , I R8 , I R9 , I R 1 0 , 

1 I R 1 1 , IR12, IR13, IR14, IR15, IR16, IR17, IR18, 

2 I R 1 9 , IR20, IR21 , IR22, IR23', IR24, IR25, I R26, 

3 I R27 , 1 R28 , 1 R29 , 1 R30, 1 R3 1 , 1 R 3 2 , 1 R33 , 1 R3 1 * . 

^ l R35 . 1 R36 , 1 R37 » 1 R38 , 1 R39 . 1 R^O , I R4 1 , 1 R42 , 

5 I R43 , I R44 , I R45 , I R46 , I R47 , I R48 , I R49 , I R50 

COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

C 

C 

C1=0.0 
C2=0.0 
D 1 1=0.0 
D2=0 .0 
D3=0.0 
D4=0.0 
D5=0.0 
D6=0 .0 
D7=0.0 
A4=0.0 
C 

DO 652 1=1, ND 

C WR I TE (6,*) 'TDLD ' ,TDLD ( I ) , 1 H I S I NC ' ,H I S I NC (I ) , 1 DELTA * , DELTA ( I ) 

C WRITE (6,*) '1= 1 , 1 , 1 D (I ) ' , D (I ) , ' FRC 1 NC 1 ,FRCINC (I) 

C1=C1+TDLD (I) *TDLD (I) 

C2=C2-TDLD ( I ) *D ( I ) 

D1 1=D1 1+TDLD (I) *DELTA (I) 

D2=D2+TDLD(I)*H I S INC (I ) 
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D3=D3+HISINC(I)*HISINC(I) 

D4=D4+H I S INC (I) *DELTA (I ) 
D5=D5-HISINC(I)*D(I) 
d6=d6+h I S I NC ( I ) *FRC I NC ( I ) 

D7=D7+TDLD (I) *FRC I NC (I) 

652 CONTINUE 

WRITE(6,*) * C 1 = ' » C 1 , * D1 = ',DM,' D2=',D2 

WRITE (6,*) 'D3=',D3.' D4=' ,DA 

DTL=F AC*F AC*C 1 
DO 660 1=1, ND 

A4=AL+DELTA ( I ) *DELTA ( I ) 

660 CONTINUE 

WRITE (6,*) ' A4, DTL ' .A4.DTL 
A4=AA-DTL 

WRITE (6,*) 'Alt FIN. *,AA 

RETURN 

END 


Nextsubrouti ne culculates the roots of eqs . for lamda (i+1) 

SUBROUT I NE CLCRT (ETAO , ETA , ATERM, C 1 , D 1 , 02 , D3, DA , AA , DTL . ROOT) 
IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGERS (I -N) 


K=0 

20 CONTINUE 
K=K+1 

IF(K.EQ.IO) THEN 

WRITE (6,*) 'NEGATIVE VALUE FOR SQRT OPER. APPROXM. GIVEN' 
WRITE (6,*) 'THE SQUARE VALUE ' , UDRT 
R00T=-A2/2.0/Al 
GOTO 200 
END IF 

A 1=ETA*C1+ATERM 

A2=2.0*D1+2.0*ETA*D2 

A3=ETA*D3+2.0*DA 

WRITE(6,*) 'A1.A2.A3 * , A 1 , ' ' ,A2, ' ',A3 

IF (ABS (A3) .LT. 0.00000000001) THEN 
R00T=-A2/A1 

WRITE (6,*) 'ATTENTION: A 3=0 ' 

RETURN 
END IF 


SOLVE THE EQUATION FOR LAMDA (1 + 1) 
UDRT=A2*A2-A,0*Al*A3 

IF (UDRT. LT. 0.0) THEN 

WRITE (6,*) 'NEGATIVE VALUE FOR THE ROOT, STOP. ' 
STOP 

ETA= (ETA+ETAO) /2.0 
GOTO 20 
END IF 

R00T1= (-A2+SQRT (UDRT) ) /2 .0/A l 
R00T2= (-A2-SQRT (UDRT) ) /2.0/A1 
CS1 = 1 .0+ETA* (DA+R00T1*D1) /DTL 
CS2=1 .0+ETA* (DA+R00T2*D1) /DTL 
C WRITE (6,*) 'R00T1.R00T2 ' , R00T1 , R00T2 

C WRITE (6,*) 'CS1.CS2 ',CS1,CS2 

IF ((CSl.LT.O.O) .AND. (CS2.GT.0.0) ) THEN 
R00T=R00T2 
ELSE 

IF ((CS2.LT. 0.0) .AND. (CS1 .GT.O.O)) THEN 
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R00T=R00T1 

ELSE 

I F (ABS (ROOT1+A3/A2) .LT.ABS (ROOT2+A3/A2) ) THEN 
I F (ABS (R00T1-1 .0) .LT.ABS (R00T2-1 .0) ) THEN 
R00T=R00T1 
ELSE 

ROOT=ROOT2 
END IF 
END IF 
END IF 


200 CONTINUE 
RETURN 
END 


C 


C 

c 


c 

c 

c 


Subroutine ASSMBL install the stiffness matrix and the load vector 


SUBROUT I NE ASSMBL (111,1 EL .ID, I ID, L, MAX A , LD , XX.YY , ZZ , DD , D * 

DLD I NC , VF , D1 , VFE ,TS, AM, P, A , ST 1 FFN, A I NV, EXLVC, 
TXVC , ADC , ADD , AD , DBVC) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8 (l-N) 

DIMENSION I EL (NEL«, 8) , I D ( T) ,1 ID (NN0DE.5) ,L (1) ,MAXA(1) , LD (1) 
DIMENSION XX ( 1 ) ,YY(1) ,ZZ(1) ,DD(1) ,D(1) , EXLVC (1) , 

DLD I NC (1) , VF (NN0DE.5) ,TXVC (1) , 

D1 (NNODE , 5) , VFE (NT, 1) ,TS (NT, NT) , P (1) ,EXLD(40) , 

A (NEQT.NEQT) ,AM(40,40) , A I NV (1) , ST I FFN (NT, NT) , 

ADC (NDBC.NDBC) , ADD (NDBC.NEQT) , AD (NEQT.NDBC) ,DBVC(1) 


COMMON /SCHALRI/ NE LM, NNODE , NT 

COMMON /SCHALR2/ NEQT , NSTEP , NHBW , COE F 1 , COE F 2 , NSHOW 1 , NSH0W2 , 

1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2 , I P3, 1 P4, I P5, I P6, 1 P7, IPS , I P9, I P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, I R6 , IR7, IR8, IR9, IR10, 

1 IRI1 , IR12, IR13, IR14, IRI5, IR16, IR17, IR18, 

2 I R 1 9 , I R20 , IR2 1 , I R22, I R2 3, I R24, I R25, I R26, 

3 IR27, IR28, IR29, IR30, IR31 , IR32, IR33. IR34, 

4 IR35, IR36, IR37-. IR38, IR39, IR40, IR41 , IR42, 

5 IR43, IR44, IR45, I R46 , IR47, I R48 , IR49, IR50 
COMMON /UN I FBD/ I R5 1 , 1 R52 , IR53, 1 R54 , 1 R55 , 1 R56 , 1 R57 . 1 R58 , I R59 
COMMON /DIRCS/ IR60, I R6 1 , !R62, IR63» I R64 , IR65 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT, TIN IT 
COMMON /RLVEC/ VR (1 j 
COMMON /INTVEC/ IPT(I) 

COMMON /CNTRL/ DETMNT 

COMMON /DISCT/ NDC.NDBC 

COMMON /D I SVC/ I R66, I R67, I R68, I R 69 

COMMON /TIDF/ IDF 


CALL MNU(NT.NT.TS) 
DO 20 1=1, NT 
EXLVC ( I ) =0 . 0 
TXVC (I) =0.0 
20 CONTINUE 


Calculation in defferent element 

DO 140 1=1 ,NELM 
I 1 = 1 EL (1 , 1) 

1 2=1 EL (1 ,2) 

1 3=1 EL (1 ,3) 

1 4=1 EL ( I ,4) 

15=1 EL (1 ,5) 

1 6= I E L (1 ,6) 

17=1 EL (1,7) 
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I 8= I EL (I ,8) 

Calculate the element stiffness. 

CALL CESM ( I 11,1,11,12,13. 14,15, 16, I 7 , I 8, VR ( I R2 1) ,VR(IR1) , 

1 VR ( I R2) ,VR(IR3) ,VR(IR14) ,VR(IR25) , EXLD.VR (I R60) , 

2 VR ( 1 R6 1 ) , VR (I R62) ) 

r 

C Build the globle stiffness matrix 

C 

DO UO J=1 ,8 
DO 140 K=l,5 

JJ=I EL (I ,J)*5-5+K 

J1=J*5-5+k 

IF (NCONS.EQ. 1) THEN 

TXVC (JJ) =TXVC (JJ) +EXLD'(J 1) 

END IF 

DO 140 M=1 ,8 
DO 140 N-1,5 

MM- 1 EL ( I ,M)*5-5+N 
Ml=M*5-5+N 

C I F (MM. LE . JJ) THEN 

TS ( J J , MM) =TS ( J J , MM) +AM (J 1 , Ml) 

WRITE (6,143) I EL (I ,J) ,JJ,MM,J1 ,M1 ,TS (JJ,MM) 

END IF 


140 CONTINUE 

143 FORMAT .(' ST I S 1 ,5 1 4 , 1 F 15- 3) 
1200 CONTINUE 


J=1 
JD=1 

DO 150 1=1, NT 

IF (IDO) .EQ.O) THEN 
L (J) =1 
J=J+1 
END IF 

IF (ID (I) .EQ.2) THEN 
LD (JD) =1 
JD=JD+1 
END IF 
150 CONTINUE 

I DF=J- 1 
JJD=JD- 1 

WRITE (6,*) 1 JJD=‘ , JJD, ' I DF=' , IDF 

idf is the number of unknown disp. 
jjd is the number of given disp. 

200 CONTINUE 

210 F ORMAT ( ' I , LD I NC , LOADT , PLD I S ' , 1 1 3, 3F8 . 3) 

Shrinking the load vector and stiff matrix, 

DO 500 1=1 , NT 
DO 500 M= 1 , 1 D F 

IF (I .EQ.L(M)) THEN 
D (M)=DLDINC (I) 

IF (NCONS.EQ. 1) THEN 
EXLVC (M) =TXVC (I) 

C WRITE (6,*) M, 1 EXLVC IN ASSMB: ',EXLVC(M) 

END I F 

. DO 510 J= 1 , NT 
DO 510 N=1 , I DF 
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IF (J.EQ.L (N) ) THEN 
A (M,N) =TS (I , J) 

END IF 

510 CONTINUE 

IF(NDC.EQ.l) THEN 
DO 505 J=1,NT 
DO 505 N=1 , JJD 

IF (J.EQ.LD(N)) THEN 
AD (M,N)=TS (I , J) 

END IF 

505 CONTINUE 

END IF 
END IF 
500 CONTINUE 
C 
C 

I F (NDC.EQ. 1) THEN 
DO 600 1=1, NT 
DO 600 M=1 , JJD 
IF (I .EQ.LD(M)) THEN 
IF (NCONS.EQ.l) THEN 
DBVC (M) =TXVC (I) 

C WRITE (6,*) M, ' EXLVC IN ASSMB: '.EXLVC(M) 

END IF 

DO 610 J=1 , NT 
DO 610 N=l, IDF 
IF (J.EQ.L (N) ) THEN 
ADD (M, N) =TS ( I , J) 

END IF 

610 CONTINUE 

DO 605 J=1 ,NT 
DO 605 N=1 , JJD 

IF (J.EQ.LD(N)) THEN 
ADC (M,N) =TS (I , J) 

END IF 

605 CONTINUE 

END IF 
600 CONTINUE 
END IF 
C 
C 

K=0 

DO 550 1=1 ,NEQT 
DO 550 J=1 , NEQT 
C K=K+1 

C P (K)=A (I , J) 

STI FFN (I , J) =A (I , J) 

550 CONTINUE 
C 

C Inverse the stiffness matrix 

C 

I J0B=1 
DD 1 = 1 .0 

C CALL LINV3F (A,BB, I JOB, NEQT, NEQT, DD1 ,DD2,AINV, I ER) 

CALL LI NRG (NEQT, A, NEQT, A, NEQT) 

DETMNT=DD 1 * (2**DD2) 

IF (I ER. EQ. 1 30) THEN 
WRITE (6,*) 'INVERSE PROB. 

STOP 
END IF 
C 

C WRITE (6,*) 'END ASSEM* 

RETURN 

END 

C (END ASSEMBL) 

C 
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Next subroutine is used to calculate the nodal force 


SUBROUTINE INTFRC (! i I , I EL, XX , YY ,ZZ, VF , PD , PDL , PLD) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGERS (I -N) 

DIMENSION XX (1) ,YY (1) ,ZZ(l) ,VF (NNODE, 5) *PD (1) , PDL (T) , PLD (1) 

D > MENS 1 ON H (2) , P (2) ,R(8) ,S(8) ,.X (8) ,Y (8) ,Z (8) ,ND (8) , I EL (NELM.8) , 

1 VFE(40) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /PNTRIN/ I Pi , 1 P2, I P3, I P4 , I P5, I P6, I P'7 , 1 P8 , I P9 , I P 10 
COMMON /PNTRRL/ I R 1 , I R2, 1 R3, 1 R4 , I R5, I R6, I R7 , I R8 , 1 R9, I R1 0 , 

1 IR1 1 , IR12, 1R13, IRU, IR15, IR16, IR17. IR18, 

2 IR19, IR20, IR21 , IR22, I R23. IR24, IR25, IR26, 

3 IR27.IR28, IR29.1R30, IR31. IR32, IR33. IR3 1 *. 

k IR35, IR36, IR37. IR38, IR39, IR40., IRi*T , IR42, 

5 IR43, IR4V, IR45, 1 R46 , \RkT, IR48, IRi»9, IR50 

COMMON /UNIFBD/ I R5 1 , IR52, IR53, IR5^, IR55. IR5&. IR57. IR58, IR59 
COMMON /DIRCS/ IR60, IR6l , IR62, IR 63 , I R64 , IR .65 
COMMON /UNICT/ NCONS,MODEL, ETAA,TDELT,TI N IT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /A3/ CL 1 (8) ,CM1 (8) ,CN1 (8) ,CL2(8) , CM2 (8) , CN2 (8) , 

1 CL3 (8) ,CM3 (8) , CN3 (8) 

c 

DO 30 1=1, NT 
PLD (l)=0,0 
30 CONTINUE 

C 

DO 700 1=1, NELM 
1 1 = 1 EL (1 , 1) 

I 2=1 EL (1 ,2) 

I 3=1 EL (I ,3) 

1 4=1 EL (I ,4) 

1 5=1 EL (1 ,5) 

|6=I EL (I ,6) 

1 7=1 EL (1 ,7) 

1 8=1 EL (1 ,8) 

Calculate the nodal force for each element 

CALL UPDATAO 11,1, I 1 , 1 2, I 3, 1 4, 15. J 6, 1 7, J 8, VR (IRl) , VR(IR2) ,VR(IR3) , 
1 VR (IRl 4) , VR ( I R22) ,VR (IR28) ,VR (IR60) , VR ( I R6 1 ) ,VR(IR62)) 


DO 700 J=1 ,8 
DO 700 K=l,5 
JJ=I EL (I ,J) *5-5+K 
jl=j*5-5+K 

PLD (J J) =PLD (J J) +PD (Jl) 
write (6, 110) I , j j , j 1 
700 CONTINUE 

RETURN 
END 

(END INTFRC) 

Subroutine CESM is used to calculate the stiffness matrix for 
each element 

SUBROUTINE CESM (I I I , I L, I 1 , 1 2 , 1 3, 1 4 , 1 5 , 1 6 , 

1 17, I8,SM,XX,YY,ZZ,VF,ESM,EXLD,GCL1,GCL2,GCL3) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

C 

C 

DIMENSION XX (1) ,YY (l) ,ZZ (1) ,VF (NNODE, 5) ,SM(40,40) ,ESM(40,40) , 
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1 H (2) , P (2) , R (8) , S (8) , X (8) , Y (8) ,HH (4) , PP (4) , 

2 Z (8) , ND (8) , VFE (40) , EXED (40) , EXLD (40) , 

3 GCL1 (NNODE, 3) ,GCL2 (NNODE , 3) , GCL3 (NNODE , 3) 

C 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /A3/ CL 1 (8) , CM1 (8) , CN1 (8) , CL2 (8) , CM2 (8) , CN2 (8) , 

1 CL3 (8) , CM3 (8) ,CN3 (8) 

COMMON /PNTRIN/ IP1 , I P2 , 1P3, IP4, IP5, IP6, I P7 , IP8, IP9, IP10 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, IR7, IR8, IR9, IR10, 

1 IR11, IR12, IR13. IR14, IR15, IR16, IR17. IR18, 

2 IR19, IR20, IR21, IR22, IR23, IR24, IR25, IR26, 

3 IR27JR28, IR29, IR30, IR31.IR32, IR33. IR34. 

4 IR35.IR36.IR37. IR38, IR39. IR40, IR41 , IR42, 

5 IR43, IR44, IR45, IR46, |R47, IR48, IR49, IR50 
COMMON /UN I F BD/ I R5 1 , 1 R52 , 1 R53 , 1 R5 1 * . I R55 , 1 R56 , 1 R57 . 1 R58 , 1 R59 
COMMON /DIRCS/ IR60, IR6l, IR62, IR63. IR64, IR65 

COMMON /CONTN/ INSIDT.KPDT, DTLM1 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 

COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

C 

c 

ND (1) =1 1 
ND (2) =1 2 
ND (3) = 1 3 
ND (4) = 14 
ND (5) = 15 
ND (6) =16 
ND (7) = l 7 
ND (8) =1 8 
C 

CALL MNU (40,40,SM) 

DO 20 1=1,40 
EXLD (I) =0.0 
20 CONTINUE 
C 

DO 250 1=1,8 
X(I)=XX (ND (!) ) 

Y ( I ) =YY (ND (I)) 

Z (I) =ZZ (ND (I)) 

C ( Change displacemet field from matrix to vector.) 

C 

DO 250 J=1 ,5 

Vfe (l*5-5+J)=VF (ND (I) , J) 

250 CONTINUE 
C 
C 

R(l)=-1 
S(1)=-1 
R (2) =1 
S (2) =-l 
R (3) =1 
S(3)=1 
R (4) =-l 
S(4)=1 
C 

R (5) =0 
S(5)=-l 
R (6) =1 
S (6) =0 
R (7) =0 
S(7)=l 
R ( 8 ) =- 1 
S (8) =0 

C WRITE ( 6 , 157) IL 
C 
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do 344 i=i,8 

CL) (l)-GCLl (ND (I) ,1) 
CM1 (I)=GCL1 (ND (I) ,2) 
CN1 (l)-GCLl (ND (I) ,3) 
CL2 ( I ) =GCL2 (ND ( I ) , 1) 
CM2 (l)=GCL2 (ND (I) ,2) 
CN2 ( I ) =GCL2 (ND (I) , 3) 
CL3(l)=GCL3(ND(i) ,1) 
CM3 ( I ) =GCL3 (ND ( I ) ,2) 
CN3 ( I ) =GCL3 (ND ( I ) * 3) 

3 44 CONTINUE 

346 FORMAT (1 I2.9F7-4) 


H (1)=1 .0 
H (2) = 1 .0 
C 

P (i) = 0 .577352692 

P (2) =-P (1) 

C 

C HH(1) =0.3478548451 
C HH (2) =H (1) 

C HH (3) =0.6521451548 

C HH (4) =H (3) 

C PP (1) =0.8611 3631 15 

C PP (2) =-P (1) 

C PP (3) =0.3399810435 

C PP (4) =-P (3) 

C 

DO 150 1=1,2 
DO 150 J=1 , 2 
DO 150 K=1 , 2 
U=P(I) 

V=P (J) 

W=P (K) 

C 

C Calculate the stiffness matrix at every integration point 
C 

CALL CB ( I I I , IL, I , J , K , U , V , W , X , Y , Z , D ET J , VR ( I R 25) ,VR(IR28) , 

1 VR ( I R29) , VR ( I R30) ,VR(IR31) ,VR( I R32) ,VR(IR33>. 

2 VR(IR34) ,VR(IR35) ,VR(IR36) ,VR(IR37) ,VR(IR 38 ) , 

3 VR (IR39) , VR ( I R40) ,VR(IR47) , EXED.VR (I R53) ,VR(IR 56 ) , 

4 VR (I R57) ) 

C 

C 

DO 150 M= 1 , 40 
IF (NCONS.EQ.l) THEN 

EXLD (M) =EXLD (M) +H ( I ) *H (J) *H (K) *EXED (M) *DETJ 
END IF 

DO 150 N=1 , 40 

SM (M, N) =SM (M,N) +H ( I ) *H (J) *H (K) *ESM (M,N) *DETJ 
C 

150 CONTINUE 

C 

C WRITE ( 6 ,*) 1 DETJ=‘ ,DETJ 

154 FORMAT ('M,N,SM (M,N) IS: 1 ,213, 1 F 1 2 . 4) 

C 

RETURN 

END 

C 

C S v. •• • 

C NEXT SUBROUTINE IS USED TO CALCULATE THE DIRECTION 

C COSINES AT NODE POINTS. HERE R,S,X,Y ARE THE NODE 

C COORD. IN REF. AND CART. COORD. RESPECTIVELY. CXR.. 

C CZN ARE THE DIRECTION COSINES. 
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SUBROUTINE CN (R,S,X,Y,Z,CXR,CYR,CZR* 

1 CXS , CYS , CZS , CXN , CYN , CZN) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION X (8) ,Y(8) ,Z(8) ,FR(8) ,FS(8) 

C XS.. MEANS DX/DS AND SO ON 
S2=S*S 
R2=R*R 

C WRITE (6,*) R, S 

C WRITE (6,*) 

C DO 20 1=1,8 

C WRITE (6, 10) I ,X(I) ,Y(I) ,Z(I) 

C 20 CONTINUE 

10 FORMAT ('X,Y,Z (I) ARE: ' , 1 1 3.3F 10.4) 

C 

F R ( 1 ) = (2 . 0*R+S) * (1 .0-S) A.O 
FR (2) = (2 .0*R-S) * (1 .0-S) A.O 
F R (3) = (2 • 0*R+S) * ( 1 . 0+S) A . 0 
FR A) = (2.0AR-S) * (1 .0+S) A.O 
FR (5) — R*(l .0-S) 

FR (6) = (1 .0-S2) /2 .0 
FR (7) =-,R* (1 .0+S) 

FR (8)=-(1.0-S2)/2.0 
C 

FS (1) = (1 .0-R) * (2.0*S+R) A.O 
F S (2) = ( 1 . 0+R) * (2 . 0*S-R) A . 0 
FS(3) = (1 .0+R) * (2 .0*S+R) A.O 
F S A) = ( 1 • 0-R) A (2 . 0*S-R) A . 0 
FS (5) =-(1.0-R2)/2.0 
FS (6) =- ( 1 . 0+R) *S 
FS(7)*(1.0-R2)/2.0 
FS (8) =- (1 .0-R) *S 
C 

XR=0 

YR=0 

ZR=0 

XS=0 

YS=0 

ZS=0 

c 

DO 315 1=1.8 
XR=XR+FR(I)*X(I) 

YR=YR+FR (I) *Y (I) 

ZR=ZR+FR (I) *Z (I) 

XS=XS+FS(I)*X(I) 

YS=YS+FS (I) *Y (I) 

ZS=ZS+FS (I) *Z (I) 

315 CONTINUE 
C 

C GRR.GSS.GRS ARE THE METRIC TENSOR IN THE REFERENCE COORD. 
C 

GRR=XR*XR+YR*YR+ZR*ZR 

GSS=XS*XS+YS*YS+ZS*ZS 

GRS=XR*XS+YR*YS+ZR*ZS 

C 

GRRH=SQRT (GRR) 

GSSH=SQRT (GSS) 

GRSHH=GRRH*GSSH 

C WRITE (6,408) R.S, GRR.GSS.GRS 

408 FORMAT ('THE METRIC AT NODE R= ',1F2.0,'S= ' , 1F2.0.3F10.5) 
C WRITE (6,409) R.S, GRRH , GSSH , GRSHH 
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1*09 FORMAT ('THE METRIC AT NODE R= \1F2.0,'S= 1 , 1 F2 .0, 3F 10 .5) 

C 

r 

C CXR IS THE DIRECTION COSINE BETWEEN THE AXES X AND R.THE 
C SAME MEANING THROUGH CZS. 

r 

CXR=XR/GRRH 

CYR=YR/GRRH 

CZR=ZR/GRRH 

C 

CXS=XS/GSSH 

CYS=YS/GSSH 

CZS=ZS/GSSH 

C 

C 

C THE CXN..ARE THE DIRECTION COSINES BETWEEN THE UNIT NORMAL 
C AND THE COORD. X,Y,Z. 

C 

CXN= (YR*ZS-ZR*YS) /GRSHH 
CYN= (ZR*XS-XR*ZS) /GRSHH 
CZN= (XR*YS-YR*XS) /GRSHH 
C 

RETURN 

END 

C 

C 

C 

C THIS IS A PROCEDURE TO MULTIPLY TWO MATRIX 
C 

SUBROUTINE MMT (I ,K, J,A1 , A2,A) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION A 1 (I ,K) ,A2(K,J) ,A(I,J) 

C 

CALL MNU (I , J , A) 

DO 20 M= 1 , I 
DO 20 N-l , J 
DO 20 L=1 , K 

TEMP=A1 (M, L) *A2 (L , N) 

A (M,N) =A (M,N) +TEMP 
20 CONTINUE 
RETURN 
END 
C 
C 

C THIS IS A PROCEDURE TO MAKE NULL MATRIX 
C 

SUBROUTINE MNU (I ,J,A) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8 (1-N) 

DIMENSION A ( I , J) 

DO 30 M=1 , I 
DO 30 N=1,J 
A (M,N) =0.0 
30 CONTINUE 
RETURN 
END 
C 

C Subroutine transp is to make transpose matrix. 

C 

SUBROUTINE TRANSP ( I , J , X I , XO) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGERS (I -N) 

DIMENSION XI (I ,J) ,XO(J, I) 

C 

DO 10 M=1 , I 
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10 


BO 10 N*1,J 

XO (N , M) =X I (M,N) 

CONTINUE 

RETURN 

END 

Subroutine GetGeom (r , s, t, tO,x,y ,z, r j ,detj) is to calculate 
the geometric property at an i ntergration point. Here input 
is: r,s - the i ntergration posi tion.tO - the thickness of the 
the shell, the x,y,z - the nodes's coordinates. The Jacobin and 
the reversed Jacobin matrix, as well as the determinate of the 
Jacobin matrix are calculated. A,B,C,D,E,G are the outputs. 

SUBROUTINE GEOM(R,S,T,TO,X,Y,Z,DETJ,A,B,C,D,E,G) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION X (8) ,Y (8) ,Z(8) ,RJ(3,3) , F (8) , FR (8) , FS (8) ,CJ (3,3) . 

2 A (8) , B (8) , C (8) , D (8) , E (8) , G (8) 

COMMON /A3/CL1 (8) ,CM1 (8) ,CN1 (8) ,CL2 (8) , CM2 (8) ,CN2 (8) , 

1 CL3 (8) , CM3 (8) , CN3 (8) 


S2=S*S 

R2=R*R 

S3=S2*S 

R3=R2*R 

C 

C F (k) is the shape function evaluated at node k. 

C 

F (1) == (1 . 0-R) * ( 1 . 0-S) * (-R-S -1.0) A . 0 
F (2) = (1 . 0+R) *(1 . 0-S) * (R-S- 1 .0) A . 0 
F (3) - (1 .0+R) * (1 .0+S) * (R+S-l .0) /A.O 
F (4) « (1 .0-R) * (1 .0+S) * (-R+S-1 .0) A.O 
F (5) • (1 .0-R2) * (1 .0-S) /2.0 
F (6) = (1. 0+R) * ( 1 . 0-S 2) /2 . 0 
F (7) = 0 -0-R2) * ( 1 -0+S) /2.0 
F (8) - (1 .0-R) * (1 .0-S2) /2 .0 
C 

C FR(k) is the derivetive w.r.t. r of the shape function 
C 

FR (1) = (2. 0*R+S) * ( 1 . 0-S) A .0 
FR (2) = (2.0*R-S) * (1 .0-S) /h.O 
FR (3) = (2 . 0*R+S) * (1 .0+S) A.O 
FR (1*) = (2 .0*R-S) * (1 .0+S) /A.O 
FR (5) =-R* (1 .0-S) 

FR (6) - (1 .0-S2) /2.0 
FR (7) =-R* (1 .0+S) 

FR (8) ■=- (1 .0-S2) /2.0 
C 

C FR (k) is the derivetive w.r.t. s of the shape function 
C 

F S ( 1 ) = ( 1 . 0-R) * (2 . 0*S+R) A.O 
FS (2) = (1 . 0+R) *(2.0*S-R)/A.0 
FS (3) = (1 . 0+R) * (2.0*S+R) /A.O 
FS (A) = (1 .0-R) * (2 .0*S-R) /A.O 
FS (5) =- (1 .0-R2) /2.0 
F S (6) =- ( 1 . 0+R) *S 
FS (7) = (1 .0-R2) /2.0 
F S (8) =- ( 1 . 0-R) *S 
C 

C CJ is the Jacobin matrix. 

C 

CALL MNU(3,3.CJ) 

C 

DO 3A6 1=1,8 

CJ (1 , 1) =CJ (1 , 1)+FR (I) * (X (!)+T*T0ftCL3 (I) /2.0) 

C J ( 1 , 2) =C J ( 1 , 2) +FR { I ) * (Y ( I ) +T*T0*CM3 (I ) /2 .0) 
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C J ( 1 , 3) =c J ( 1 , 3) +FR ( I ) * (Z ( I ) +T*to*CN 3 ( I ) /2 , 0) 
CJ (2 , 1) -CJ (2 , 1) +FS (I ) * (X ( I ) +T*T0*CL3 (I ) /2 .0) 
C J (2 , 2) =C J (2 , 2) +FS ( I ) * (Y ( I ) +T*T0*CM3 ( I ) /2 .0) 
C J (2 , 3) -C J (2 , 3) +F S ( I ) * (Z ( I ) +T*T0*CN3 (I) /2.0) 
CJ (3, D=F (I) *TO*C!_3(l)/2. 0+CJ (3,1) 

CJ (3.2) =F (I) *T0*CM3 ( I ) /2, 0+CJ (3,2) 

CJ (3,3) =F (l)*T0*CN3(l)/2.0+CJ (3,3) 

346 CONTINUE 

Detj is the determinate of the Jacobin matrix. 

DETJ=CJ (1,1) * (CJ (2,2) *CJ (3 , 3) - CJ (3,2) *CJ (2 , 3) ) 

1 -C J ( 1 , 2) * (C J (2 , 1 ) *CJ (3 , 3) -C J (3,1) *CJ (2 , 3) ) 

2 +C J ( 1 , 3) * (C J (2,1) *CJ (3 , 2) - CJ (3 , 1) *C J (2 , 2) ) 

WRITE (6,347) DETJ 

347 FORMAT ('DETJ IS' , 1 F 1 2 . 9) 

RJ is the inverse of the jacobin matrix. 


R J ( 1 , 1 ) = (C J (2 , 2) *CJ (3 , 3) -C J (3 , 2) *CJ (2 , 3) ) /DETJ 
RJ (1 , 2) =- (CJ (1 , 2) *CJ (3 , 3) -CJ (3,2) *CJ (1,3)) /DETJ 
RJ (1 , 3) = (CJ (1,2) *CJ (2 , 3) "C J (2 , 2) *CJ (1 , 3) ) /DETJ 


RJ (2 , 1) =- (C J (2,1) *CJ (3 , 3) -C J (3,1) *CJ (2 , 3) ) /DETJ 
RJ (2 , 2) = (CJ (1 , 1) *CJ (3 , 3) -C J (3, 1) *CJ (1 , 3) ) /DETJ 
R J (2 , 3) =- (C J ( 1 , 1 ) *CJ (2 , 3) - C J (2 , 1 ) *C J (1,3)) /DETJ 

RJ (3, 1) = (CJ (2, 1) *CJ (3,2) -CJ (3, 1) *CJ (2,2)) /DETJ 
RJ (3 , 2) =- (CJ (1 , 1 ) *CJ (3 , 2) -C J (3 , 1) *CJ (1 ,2) ) /DETJ 
RJ (3,3) = (CJ (1 , 1) *CJ (2,2) -CJ (2,1) *CJ (1 ,2)) /DETJ > 

DO 360 1=1,8 

A ( I ) =RJ ( 1 , 1 ) *F R ( I ) +RJ ( 1 ,2) *F S ( I ) 

B (I) =RJ (2, 1) *FR (l)+RJ (2,2) *FS (I) 

C (I) =RJ (3,1) *FR (l)+RJ (3, 2) *FS (I ) 

D (I) =T0* (A (I) *T+R J ( 1 , 3) *F (l))/2.0 
E ( I ) =T0* (B ( I ) *T+R J (2 , 3) * : F (I ) ) /2 .0 
G ( I ) =T0* (C ( I ) *T+RJ (3, 3) *F ( I) ) /2 .0 
360 CONTINUE 

RETURN 

END 


Subroutine Rotsmatrix is to get the rotate transformation matrix. Here 
the input is r,s,x,y,z. Output is transformation matrix tl. 

SUBROUT I NE ROTMTRX (R , S , X , Y , Z ,TL) 

IMPLICIT REAL*8 (A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION X (8) , Y (8) ,Z(8) ,TL (6,6) 

COMMON /PNTRIN/ I Pi , I P2, I P3, I P4, 1 P5, 1 P6, 1 P7 , 1 P8, I P9, 1 P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, IR7, IR8, IR9, I R 1 0 , 

1 I R 1 1 , I R 1 2 , 1 R 1 3 , IR14, IR15, IR16, IRT7, 1'RIB, 

2 IR19, IR20, IR21 , IR22, IR23, IR24, IR25, IR26, 

3 I R27 , I R28 , I R29, I R30 ,1 R3 1, I R32 , I R33 , IR34 , 

4 IR35.IR36, IR37, IR38, IR39, IR40, IR41, IR42, 

5 IR43, IR44, IR45, IR46, IR47, I R48, I R49, IR50 
COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ IPT(l) 

CALL CN(R,S,X,Y,Z,PL1,PM1,PN1,PL2,PM2,PN2,PL3,PM3,PN3) 

WRITE(6,*) 'PL1=',PL1,' P L 2 = 1 , PL 2 , 1 P L 3= 1 , P L 3 
WRITE (6,*) ' PM1 = ‘ , PM1 , ' PM2=' ,PM2, ' PM3=' ,PM3 
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C WRITE (6,*) ' PN 1 = * , PN1 , ' PN2=',PN2,' PN3=' ,PN3 
TL (1 , 1) «*PL 1**2 
TL (2 , 1) =PL2**2 
TL(3,1)=PL3**2 
TL (4, 1)=PL1*PL2*2.0 
TL (5, 1) =PL2*PL3*2 .0 
TL (6, 1) =PL3*PL 1*2.0 

TL (1 , 2) =PM1 **2 
TL (2,2) =PM2**2 
TL (3» 2) =PM3**2 
TL (4,2)=PM1*PM2*2.0 
TL (5> 2) =PM2*PM3*2 .0 
TL (6 , 2) =PM3*PM1 *2 . 0 
C 

TL (1 , 3) =PN1**2 
TL (2,3) =PN2**2 
TL (3,3) =PN3**2 
TL (4,3) =PN1*PN2*2 .0 
TL (5,3) =PN2*PN3*2.0 
TL (6,3) =PN3*PN 1*2.0 
C 

TL (1 , 4)=PL1*PM1 
TL (2,4) *PL2*PM2 
TL (3,4) =PL3*PM3 
TL (4 , 4) =PL 1 *PM2+PL2*PM1 
TL (5,4) =PL2*PM3+PL3*PM2 
TL (6,4) =PL3*PM1+PL1*PM3 
C 

TL (1 ,5) =PM1*PN1 
TL (2,5) =PM2*PN2 
TL (3,5) =PM3*PN3 
TL (4 , 5) -PM1 *PN2+PM2*PN 1 
TL (5,5) =PM2*PN3+PM3*PN2 
TL (6 , 5) “PM3*PN 1+PM1 *PN3 
C 

TL (1 ,6) =PN1*PL1 
TL (2,6) =PN2*PL2 
TL (3,6) SS PN3*PL3 
TL (4 , 6) =PN 1 *PL2+PN2*PL1 
TL (5 , 6) =PN2*PL3+PN3*PL2 
TL (6,6) =PN3*PL1+PN1*PL3 
C 

RETURN 

END 

C 

C ,, . _ - ^ 

C Subroutine nonlm is to get the nonlinear part of the matrix B. Here 

C the input is the geometric parameters a,b,c,d,e,g and the direction 

C cosines. The parameter ss is the stress calculated in last iteration. 

C The output is the matrix bn 1 (40, 40) and bn2(40,40) 

C 

SUBROUT I NE NONLM (A , B , C , D , E , G , SS , SS 1 , BN 1 , BN2 , BN3 , B 1 , B IT , TMPSS) 
IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER^ (I -N) 

DIMENSION A (8) ,B (8) ,C (8) ,D (8) ,E (8) ,G (8) ,SS (9,9) ,SS1 (9,9) , 

1 BN1 (40,40) , BN2 (40, 40) ,BN3(40,40) ,B1 (9,40) , 

2 BIT (40,9) , TMPSS (40,9) 

C 

COMMON /SCHALR1/ NELM.NNODE ,NT 

COMMON /PNTRIN/ I PI , ! P2, 1 P3, 1 P4, 1 P5, 1 P6, IP?, I P8 , IP9, IP10 
COMMON /PNTRRL/ I R1 , 1 R2, 1 R3, 1 R4, 1 R5, 1 R6, 1 R7, 1 R8, 1 R9, 1 RIO, 

1 1 R 11 , IR12.IR1 3 , IR14, 1 R 1 5 , I R 1 6 , IRl?, 1 R 1 8 , 

IR19, IR20, IR21, IR22, IR23, IR24, IR25, I R26, 

I R27, I R28 , I R29 , I R30 , I R3 1 , I R32 , I R33 , I R3^ , 

I R35 , I R36 , I R37 , I R38 , I R39 , I R40 , I R4 1 , I R42 , 
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5 IR43, IR44, 1R45, IR46, IR47, IR48, IR49, IR50 

COMMON /RLVEC/ VR (1) 

COMMON / i NTVEC/ IPT(l) 

COMMON /A3/CL1 (8) ,CM1 (8) ,CN1 (8) ,CL2 (8) ,CM2 (8) ,CN2 (8) , 

1 CL3 (8) ,CM3(8) ,CN3(8) 


CALL MNU (9,40, Bl) 


DO 413 1=1,8 
B1 (1,1 *5-4) =A ( I ) 

B 1 (2, l*5-4)=B(l) 

B 1 (3, 1 *5-4) =C (1) 

B1 (4, 1*5-3) =A (1) 

B 1 (5, 1*5-3) =B ( I ) 

B1 ( 6 , 1*5-3) =C (I) 

B1 (7, 1*5-2) =A (1) 

B1 ( 8 , 1 *5-2) =B (I) 

B1 (9,I*5-2)=C(.I) 

B 1 (1 , 1*5-1) =-D (I) *CL2 (I) 
B 1 (2, 1*5-1)— E ( I ) *CL2 ( I ) 
B 1 (3, 1*5-1)— G (I) *CL2 (!) 
B1 (4, 1*5-1)— D(I) *CM2 (I) 
B1 (5, l*5-D— E (l) *CM2(l) 
B 1 (6, I * 5 - 1 ) — G ( I) *CM2 ( I ) 
B 1 (7, I *5-1) — D (I ) *CN2 (I) 
B 1 (8, 1*5-1)— E (!) *CN2 (I) 
B1 (9, l*5-D— G (I) *CN2 (I) 

B 1 ( 1 , 1 * 5 ) =D (I) *CL 1 (I) 

B1 ( 2 , I *5) =E ( I ) *CL 1 (I) 

B1 (3, 1*5) =G (I) *CL1 (!) 

B1 (4, 1 *5) =D (I) *CM1 (I) 

B 1 (5, l*5)=E ( I ) *CM1 (I) 

B1 ( 6 , l*5)-G (I)*CM1 (I) 

B1 (7, 1*5) =D (I) *CN1 (I) 

B1 ( 8 , l*5)=E (!) *CN1 (!) 

B1 (9 , I *5) =G ( I ) *CN 1 (I) 

413 CONTINUE 


DO 430 1=1,40 
DO 430 J=l,9 

BIT (I ,J)=B1 (J, I) 

430 CONTINUE 
C 

CALL MMT (40,9,9.B1T,SS,TMPSS) 

CALL MMT (40,9>40,TMPSS,B1 ,BN1) 
C 

CALL MMT (40, 9, 9, BIT, SSI ,TMPSS) 
CALL MMT(40,9,40,TMPSS,B1,BN3) 
C 

C B2=B1 NOW. 

CALL MNU (9, 40, Bl) 

C 

DO 4 1 4 1=1,8 

Bl (1,1 *5-4) =A (I) 

Bl (2, 1*5-4) =B(l)/2.0 
Bl (3, 1*5-4) =C (D/2.0 
Bl (4, 1*5-4) =B (I) /2 .0 
Bl (7» 1*5-4) =C (l)/2.0 
C 
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B1 (2, 1*5-3) =A (I) /2.0 
B1 ('*,l*5-3)=A(l)/2.0 
Bl (5* l*5~3)=B (I) 

Bl (6, 1 * 5 - 3 ) =C (I) /2.0 
Bl (8, 1*5-3) =c <l) / 2.0 

C 

Bl (3, 1*5-2) =A (1) /2.0 
Bl (6, 1*5-2) =B (!) /2.0 
Bl (7, 1*5-2) =A (I) /2.0 
Bl (8, 1*5-2) “B ( 1)72.0 
Bl (9, 1*5-2) =C (I) 

C 

Bl (1,1 *5- 1 ) =~D ( I ) *CL2 ( I ) 

Bl (2, 1*5-1) =- (E (I) *CL2 (l)+D (I) *CM2 (l) ) /2.0 
Bl (3, 1*5-1)=- (G (I ) *CL2 (1 )+D (l ) *CN2 (I ) ) /2 .0 
Bl (4, 1*5-1) =-(E(l)*CL2(l)+D(l)*CM2(l))/2.0 
Bl (5» 1*5-1) =~E (I) *CM2 (I) 

Bl (6, 1*5-1)=- (G (I) *CM2 (l)+E (I) *CN2 (I) ) /2.0 
Bl (7, 1*5-1) =- (G (I) *CL2 (l)+0 (I) *CN2 (I) ) /2.0 
Bl (8, 1*5-1)=- (G ( I ) *CM2 ( I ) +E (I) *CN2 (I) ) /2.0 
Bl (9, 1*5-1) =~G (I) *CN2 (I) 

C 

Bl (1 , 1*5) =D (I) *CL1 (I) 

Bl (2,1*5) = (E (I) *CL1 (l)+D (I) *CM1 (l))/2.0 
Bl (3, 1 *5) = (G (I ) *CL1 ( I ) +D ( I ) *CN 1 (I ) ) /2 .0 
Bl (A, I *5) = (E ( I ) *CL1 (I)+D(I)*CM1 (l))/2.0 
Bl (5. I*5)=E (I) *CM1 (I) 

Bl (6, 1 *5) = (G (I) *CM1 (l)+E (1 ) *CN 1 (I ) ) /2 .0 
Bl (7, I*5) = (G(I)*CL1 (I)+0(I)*CN1 (l))/2.0 
Bl (8, l*5) = (G (I) *CM1 (l)+E (I) *CN1 ( I ) ) / 2 . 0 
414 CONTINUE 
C 

DO 432 1=1,40 
DO 432 J=1 ,9 

B 1 T ( I , J) =B1 (J, I) 

C B2T (I , J) =B2 (J, I) 

432 CONTINUE 
C 
C 

CALL MMT (40,9,9,B1T,SS,TMPSS) 

CALL MMT (40,9»40,TMPSS,B1 ,BN2) 

C 

C 

RETURN 

END 

C (end nonlm) 

C 

c 

C Subroutine ELSMTR is used to calculate the elastic matrix 
C 

SUBROUTINE ELSMTR (EM) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT I NTEGER*8 (I -N) 

DIMENSION EM (6,6) 

COMMON /MTL/ E,EU 
U=EU 

CALL MNU(6,6,EM) 

EM (1 , 1) =E/ (1 .0-U*U) 

C WRITE (6,*) 1 EM= 1 , EM ( 1 , 1 ) 

EM (2 , 2) =EM (1 , 1) 

EM (3,3) =1 *0 

EM(1 ,2)=E*U/(1 .0-U*U) 

EM (2, 1) =EM (1 , 2) 

EM (5,5) =E/2/(1+U) 

EM (4,4) =EM(5,5) 

EM (6, 6) “EM (5,5) 
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VJl to 


RETURN 
END 

(enc elsmtr} 

This procedure is used to calculate the nodal force in 
every element 

SUBROUTINE UPDATA (I I I , I L , 1 1 , 1 2, 1 3, I 4, 15, 1 6 , 17, l8,XX,YY,Z2, 

1 VF,PD,PDL,GCL1,GCL2,GCL3) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER* 8 (I-N) 

DIMENSION XX (1) ,YY(1) ,ZZ(1) ,VF (NNODE ,5) ,'PD (1) ,PDL (1) 
DIMENSION H (2) , P (2) ,R( 8 ) ,S ( 8 ) ,X( 8 ) , Y ( 8 ) ,Z( 8 ) ,ND( 8 ) , 

V VFE (40) , GCL 1 (NNODE, 3) , GCL2 (NNODE , 3) , GCL3 (NNODE , 3) , 

2 HH(4),PP(4) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /PNTRIN/ I PI , I P2, I P3, I P4, 1 P 5 , I P 6 , 1 P7, 1 P 8 , I P9, 1 PIO 
COMMON /PNTRRl/ IR1,IR2, IR3, IR4, IR5, IR6,IR7,IR8, IR9.IR10, 

1 I R] 1 , IR1 2, 1 R1 3, I R 1 4 , 1 R 1 5 » I R 1 6 , IR17. 1R18. 

IR19, IR20, IR21, IR22, IR23, IR24, IR25, IR 26 , 

I R27 , I R28 , I R29 , I R30 , I R3 1 , I R32, I R33 . I R34 , 

IR35, IR36.IR37.IR38, IR39, IR40, IR4l , IR42, 

I R43 , I R44 , I R45 , I R46 , I R47, I R48 , I R49 , I R 50 
COMMON /UNIFBD/ IR5MR52, IR53, IR54, IR55, IR5&. IR57. IR58, IR59 
COMMON /DIRCS/ IR 60 , IR 61 , IR 62 , IR63, IR64, IR 65 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ IPTO) 

COMMON /CONTN/ I NS I DT, KPDT, DTLM1 

COMMON /A3/ CL 1 ( 8 ) ,CM1 ( 8 ) ,CN1 ( 8 ) ,CL2 ( 8 ) ,CM2(8) ,CN2(8) , 

1 CL3 ( 8 ) , CM3 ( 8 ) , CN 3 ( 8 ) 

C 

C 

ND (1) = I 1 
ND (2) = 1 2 
ND (3) — I 3 
ND (4) = 14 
NO (5) =15 
ND ( 6 ) =16 
ND (7) =1 7 
ND ( 8 ) = 18 
C 

DO 250 1=1,8 
X(I)=XX (ND(I)) 

Y ( I ) =YY (ND ( I ) ) 

Z (I) =ZZ (ND (I) ) 

C WRITE ( 6 , 260 ) l,X(l) ,Y(I) ,Z(I) ,ND(I) 

do 250 J= 1 ,5 

VFE (I*5-5+J)=VF (ND (I ) , J) 

250 CONTINUE 

260 FORMAT (IX, 'THE COORDINATES OF NODE', I 2, IX, 1 ARE : ' , 3F 1 2 .8, 1 1 2) 
C 
C 

R(l)=-1 
S (1)=-1 
R (2) =1 
S (2) =- 1 
R (3) =1 
S (3) =1 
R (4) =-l 
S (4) =1 
C 

R (5) =0 
S (5) =-l 

R(6)=1 ok 



S (6) =0 
R (7) =0 
S (7) =1 
R(8)=-l 
S (8) =0 


c 


c 


c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


DO 344 1 = 1,8 

CL 1 ( I ) =GCL 1 (ND (I) , 1) 
CM1 ( I ) =GCL 1 (ND (I) ,2) 
CN1 ( I ) — G C L 1 (ND ( I ) ,3) 
CL2 ( I ) =GCL2 (ND (I) , 1) 
CM2 ( I ) =GCL2 (ND ( I ) ,2) 
CN2 (I ) =GCL2 (ND (!) , 3) 
CL3 (1) =GCL3 (ND ( i ) ,1) 
CM3(1)=GCL3(ND(I) ,2) 
CN3(I)=GCL3(ND(I) ,3) 

344 CONTINUE 

346 FORMAT (1 12, 9F7- 1 *) 

DO 348 1=1,40 
PD (I ) =0.0 
348 CONTINUE 


H (1)=1 .0 

H ( 2) =1 .0 

WRITE (6,*) SM (1 , 1) , SM (2 , 2) 

P (1) =0.577352692 
P (2) =-P (1) , 

HH (1) =0.3478548451 
HH (2) =H (1) 

HH (3) =0.6521451548 
HH (4) =H (3) 

pp(i)=o. 8611363115 

PP (2) =-P (1) 

PP (3) =0.3399810435 
PP (4) — P (3) 

DO 150 1=1,2 
DO 150 J=l,2 
DO 150 K=1 , 2 
U=P(I) 

V=P (J) 

W=P (K) 

WRITE ( 6 , 157) IL 

CALL CBUPDT (I I I , I L,ND, I , J,K,U,V,W,X,Y,Z,VR ( I R 1 4) ,VR(IR28) , 

1 DETJ.VR (IR31) ,VR (IR32) ,VR(IR33) ,VR(IR29) , 

2 VR (I R37) , VR (I R 38 ) , VR (IR 36 ) ,VR(IR39) ,VR(IR40) , 

3 VR ( I R30) ,VR (IR20) ,VR(IR47) ,VR(IR54) ,VR(IR55) , 

4 VR (I R57) ) 


DO 150 M= 1 , 40 

PD (M) =PD (M) +H ( I ) *H (J) *H (K) *PDL (M) *DETJ 
wr i te (6,10) m,pdl (m) ,pdl (m) ,detj 
WRITE (6,*) 'PD(M) 1 , PD (M) 

150 CONTINUE 

DO 151 1=1,40 
WRITE (6,*) 'PD(M) ',PD(I) 

151 CONTINUE 

10 format (’ integ. i ,pdl (i) ,pd (i) ,DETJ is: * , 1 i 3 , 3f 1 3 - 5) 


WRITE ( 6 , 153) DETJ 
153 FORMAT ( 1 DETJ IS:',1F12.4) 
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c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


RETURN 

END 

(end update) 


SUBROUTI NE GETDT (I EL, I D, I I D,NEQ,MX,NHLF ,NN,MEQT, 

1 XX,YY,ZZ,DD1 , DD2) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT I NTEGER*8 ( I -N) 

Subroutine GETDT is designed to read data from data file. The data 
needed are: 

nelm: The numberr of elements in the structure, 
nnode: The number of node of the structure, 
nstep: The number of load step to be taken, 
ncrtr : The max. iterations to balance the node force. 
xx,yy,zz: initial coordinates of the nodes 

i e 1 ( i , j ) : The node name, here i is the element name 

and j is the node sequence in the local 
corord i nate. 

id (i) (i=5*nnode): The the constrain for displacement 

iid(i.j): The boundary constrain for displacement, 

here i — element j< — generalized displacement, 
dd (i , j) : The load at node i corespond to the direction j. 

Data calculated: 

NHBW: the half-band-width of the problem, 

neqt: The number of equation to be solved. 


DIMENSION I EL (NELM, 8) , I D (1) , I I D (NNODE, 5) ,NEQ (NNODE, 5) , 

1 MX (1) ,NHLF (1) ,MN (1) ,M£QT(NELM,AO) 

DIMENSION XX (1) ,YY(1) ,ZZ(1) ,DD1 (l) ,DD2(1) 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT.NSTEP.NHBW.COEFl ,C0EF2,NSH0W1 .NSH0W2, 
1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 P3, 1 P4, I P5, 1 -P.6, I P? , I P8, 1 P9, I P10 
COMMON /PNTRRL/ I R 1 , I R2 , 1 R3 , 1 R4, i R5, I R6 , I R'7 , I R'8 , 1 R9 , 1 R 1 0 , 

1 I R 1 1 , I R 1 2 , 1 R 1 3 » IRH.IR15, 1 Rl 6 , IR17, IR.18, 

2 I R 1 9 , IR20.IR21, IR22, IR23, IR24, IR25, IR26, 

3 IR27, IR28, IR29, IR30, IR31 , IR32, IR33.IR34, 

k IR35, IR36, IR37, IR38, IR39, IR40, I R4 1 , IR42, 

5 !R^3, IR44, 1-R45, 1R46, IR1*7, IR48, 1R1*9, IR50 

COMMON /RLVEC/ VR(1) 

COMMON /INTVEC/ IPT(l) 

COMMON /MTL/ E,EU 
COMMON /GEO/ TO 
COMMON /DISCT/ NDC,NDBC 
COMMON /OUTVR/ NPT.NPV 


WRITE (6, 10) NELM 

10 FORMAT (' THE NUMBER OF ELEMENT IS: ',113) 

WRITE (6,20) NNODE 

20 FORMAT (' THE NUMBER OF NODES IS: ',115) 

WRITE (6,30) E , EU 

30 FORMAT (' THE MATERIAL CONSTANTS E AND NU ARE: * ,2F 13-3) 
WRITE (6,*) 1 THE THICKNESS OF THE SHELL IS: 1 ,T0 
DO 100 N0DE=1, NNODE 

READ (5,*) KK,XX (NODE) , YY (NODE) ,ZZ (NODE) 

WRITE (6, 101) NODE, XX (NODE) , YY (NODE) ,ZZ(N0DE) 

100 CONTINUE 

101 FORMAT ( 1 THE COORDINATES OF NODE ',112,' IS: * , 3F 12-5) 


C 

C 
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DO 106 1*1, NNODE 

READ (5 , *) KK, (IID(I,J) ,>1,5) 

WRITE ( 6 , 107) i , (I I D (I , J) , J=1 ,5) 

C WRITE ( 6 , 107) l,IID(l,U,IID(l,2),IID(l,3), 

1 I ID (1 ,4) , I ID (1 ,5) 

:0b CONTINUE 

10? F 0RMA7 ( 1 THE CONSTRAIN AT NODE ',113,' I S', 51 3) 

NDBC=0 

DO 108 1 * 1 , NNODE 
DO 108 J=1 ,5 

1 D (|* 5 - 5 +j) = | I D (I , J) 

IF (ID (l*5-5+J) .EQ.2) NDBC=NDBC+1 
108 CONTINUE 
NDC=0 

IF (NDBC.NE.O) NDC=1 

C WRITE ( 6 , A) 'The first group load is : 1 
C DO 110 1*1, NNODE 

C READ (5 , *) KK , (DD 1 ( I *5“5+J) , > 1 , 5) 

C k=i*5-5 

C WRITE ( 6 , 1 11*) I , DD 1 (K+l) ,DD1 (K+2) , D0 1 (K+3) ,DD1 (K+4) ,DD1 (K+5) 

r; 110 CONTINUE 

C 

WRITER,*) 'THE SECOND GROUP LOAD IS:' 

DO 112 1*1, NNODE 

READ (5,*) KK, (DD2(l*5-5+J) , J=1 ,5) 

K= I * 5-5 

WRITE (6, 1 14) I ,DD2 (K+l) ,DD2 (K+2) ,DD2 (K+3) ,DD 2 (K+4) ,DD2 (K+5) 

112 CONTINUE 

114 FORMAT ( 'THE LOAD CORRESP. TO NODE ',112,' IS: *,5F8.3) 

DO 122 1*1 ,NELM 

READ (5,*) KK, (IEL(I ,J) ,J*1,8) 

WRITE (6,126) I , I EL (I , 1) , I EL (I , 2) , I EL (1 , 3) , I EL (1 ,4) , 

1 I EL (I ,5) » I EL (1 , 6 ) , I EL (1 , 7) * I EL (I , 8 ) 

122 CONTINUE 

READ (15,*) NPT.NPV 

126 FORMAT (' THE NODE NUMBER FOR ELEMENT ',112,' IS: ', 8 1 4) 

Next part is to calculate the half band width of the stiffness matrix. 

For every unknown disp. get the correspond eqution number: NEL(I,J) 

K=1 

DO 200 1*1, NNODE 
DO 200 J=1 ,5 

IF(IID(I,J) . EQ. 1) THEN 
NEQ (I , J) *0 
ELSE 

IF (I ID (I ,J) . EQ.O) THEN 
NEQ (I , J) =K 
K=K+1 
END IF 
END IF 

200 CONTINUE 
NEQT=K-1 

WRITE (6,400) NEQT 

400 FORMAT ('THE NUMBER OF EQUATIONS IS: ' , 1 1 6 ) 

C 

C CALL MNU (NELM,40,MEQT) 

C ^ ^ 

C Get all the equation number in element i : MEQT(I,K) (k*1..40) here. 

C 

C DO 240 1=1 ,NELM 

C K=1 

C DO 240 J= 1 ,8 


38 



o o o r> o o o o o o o o o o o 


C DO 240 M=1 ,5 

C MEQT (i , K) =NEQ (I EL (I , J) ,M) 

C WRITE (6,500) I , K.MEQT (I ,K) 

C K=K+1 

C 240 CONTINUE 
C 

500 FORMATCTHE EQ. NUMBER IN ELM(I) (K=l . .40) IS: ’,316) 

C DO 600 K=1 , 40 

C WRITE (6,515) K.MEQT (1 ,K) 

C 600 CONTINUE 

C 515 FORMATCTHE MEQT (1 ,K) IS:', 215) 

C 

C Get the max and min eq. number in an element. The difference is the 
C ha 1 f -band-width of the stiffness matrix in the element 
C 

C DO 280 1=1 ,NELM 

C MX ( I ) =0 

C MN ( I ) =NT 

C DO 300 K=1 ,40 

C IF (MEQT (I ,K) .GT.MX(I)) THEN 

C MX (l)=MEQT (I ,K) 

C WRITE (6,490) I ,K,MEQT (I ,K) , MX ( I ) 

C 490 F ORMAT ( ' I , K , MEQT ( I , K) , MX ( I ) : 1 ,415) 

C END I F 

C I F ( (MEQT (I ,K) .GT.O) .AND. (MEQT (I , K) .LT.MN (I))) THEN 

C MN (l)=MEQT (I ,K) 

C END IF 

C 300 CONTINUE 
C NHLF ( I ) =MX ( I ) -MN ( I ) 

C WRITE (6,460) I ,MX (I) ,MN (I) ,NHLF (I) 

C 280 CONTINUE 

C 460 FORMAT('The max, min and half band width in el (i) is: ' , 4 i 5) 

C 

C Get the half-band-width of the stiffness matrix of the structure 
C 

C NHBW=0 

C DO 320 1=1 ,NELM 

C IF (NHLF (I) .GT.NHBW) NHBW=NHLF (I) 

C 320 CONTINUE 
C 

C WRITE (6,440) NHBW 

440 FORMATCTHE HALF-BAND-WIDTH OF THE STIFFNESS MATRIX IS: ',115) 
RETURN 
END 
C 
C 

SUBROUT I NE CRITR1 (I I ,ND,D,FRCINC, ACTFRC , DDD , VL I MN , I CNC 1 , VALS) 
IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8 (l-N) 

Subroutine CRITR1 is to build an exit criteria for the equilibrium 
iterations, 
i nput: 

ii = The i i ' th number iteration 
DLDINC = The load increament 
DLOADT = Te load level at that iteration. 

PLD = The node force in last iteration 
DVEC = The unknown solved in last iteration 

VLINIT = the criteria value calculated in the first iteration. 
Output: 

ICONCL = The conclusion : Exit the loop or not. 

1 = exit 

0 = Keep inside the loop. 

DIMENSION D (1) , FRC INC (1) , ACTFRC (1) ,DDD (1) 

COMMON /PNTR IN/ IP1JP2, IP3, 1 P4 , 1 P5, 1 P6, 1 P7 , IP8.IP9, IP10 
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COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, t R6 , IR7, IR8, IR9, IRIO, 

1 IR1 1 , IR12, 1 R 1 3 » IR14, IR15» IR16, IR17. IR18, 

2 IR19, IR20, IR21 , IR22, IR23, IR24, IR25, I R26, 

3 IR27, IR28, IR29, IR30, IR31 , IR32, IR33, I R3^ , 

U IR35, »R36, IR37. IR38, IR39. IR40, IR41 , IR42, 

5 I RJ»3 » I RM> , I Rfr5 1 1 * J Rfc7* I M8, I R**9 . 1 R5Q 

COMMON /UNIFBD/ IR5J , IR52, IR53, IR5 1 *, IR55. IR56, IR57, IR58, IR59 
COMMON /SCHALR1/ NELM.NNODE.NT 
COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT, DTLAM, SON, I PP.TROOT, ASO.SP 
COMMON /DISCT/ NDC.NDBC 


AINS=0.0 
C0EFF=90.0 
VLIMNO=VLIMN 
VAL=0 .0 

IF(II.EQ.I) THEN 
VLIMN=0.0 
DO 10 1=1, ND 

C I F (NDC.EQ.O) THEN 

TEMP=D ( I ) *ROOT-FRC I NC ( I ) 

C ELSE 

C TEMP=DDD ( I ) *ROOT-FRC I NC ( I ) 

C END IF 

C AINS=AINS+TEMP 

VL I MN=VL I MN+TEMP*TEMP 
IF(I.LT.ll) THEN 

WRITE (6,90) I I , I , D ( I ) *ROOT , FRC I NC ( I ) ,ACTFRC(I) 
END IF 

C WRITE ( 6 , 80) I I , I ,D (I) *ROOT,FRCINC (I) ,TEMP,VAL 

C 80 FORMAT (' I I , I ,D (I) ,FRCINC,TEMP: ' ,2ll»,4F12.3) 

10 CONTINUE 

VL I MN=SQRT (VL I MN) 

VAL=VL I MN 

WRITE (6,*) 'VAL=',VAL 
ELSE 

DO 20 1=1, ND 

C IF (NDC.EQ.O) THEN 

TEMP=D ( I ) *ROOT-FRC I NC ( I ) 

C ELSE 

C TEMP=DDD(l)*ROOT-FRCINC(l) 

C END IF 

VAL=VAL+TEMP*TEMP 
C A I NS=A I NS+TEMP 

C IF ((I.EQ.2) .OR. (I.EQ.7)) THEN 

IF (I.LT.10) THEN 

WRITE (6,90) I I , I ,D (I) *ROOT,FRCINC (I) ,ACTFRC(I) 
END IF 

90 FORMAT ('ll,l»D(l),FRCI NC, ACTF : ' ,2lfe,3FU.6) 

20 CONTINUE 

VAL=SQRT (VAL) 

END IF 

C WRITE (6,*) 1 AINS 1 , A1NS 

C 

I CNC1=0 

VALS=VAL*COEFF 

I F (VLIMN.GT. 10.0) VLIMN=10.0 
IF (NDC.EQ.l. AND. VLIMN.LT. 0.005) I CNC1=1 
IF (VALS.LT.VL IMNO) I CNC 1=1 
WR I TE ( 6 , 50) VAL*COE F F , VL I MN , I CNC 1 
50 FORMAT (' VAL 1,CR I Tl.CONCL ARE: ' , 2F 1 4 . i» , 1 1 3) 

C 


RETURN 
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END 


SUBROUTINE CRITR3 (I I , ND , D , FRC I NC , ACTFRC, DDD , VL I MN , ICNCl.VALS) 
IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGERS (I -N) 

Subroutine CRITR3 is to build an exit criteria for the equilibrium 
i terations 

i nput : 

ii » The i i 1 th number iteration 
DLDiNC = The load increament 
DLOADT « Te load level at that iteration. 

PLD = The node force in last iteration 
DVEC = The unknown solved in last iteration 

VLINIT = the criteria value calculated in the first iteration. 
Output: 

ICONCL » The conclusion : Exit the loop or not. 

1 = exi t 

0 * Keep inside the loop. 

Cx 

DIMENSION D (1) , FRCJNC (1) , ACTFRC (1) ,DDD (1) 

COMMON /PNTRIN/ -IP1, IP2, IP3, IP4. IP5. IP 6 , IP7, IP 8 . IP9. IP10 
COMMON /PNTRRL/ I R 1 , I R2 , I R3 , 1 Ri» , I R5 , I R 6 • I R7 . 1 R 8 , I R9 , I R 1 0 , 

1 I R 1 1 , IR12, 1 R 1 3 . IR14, IRIS. IRl6,IR17, 1 R 1 8 , 

2 I R 1 9 » IR20, IR21 , IR22, IR23, 1 R2i* , IR25, IR26, 

3 IR27, IR28, IR29, IR30, IR31 , IR32, IR33, i R3^ . 

A IR35, IR36. IR37, IR38, IR39. 1 RAO, IRA1 , IR42, 

5 IRA3, IRAA, IR45, IRA 6 , IRA7, IRA 8 , IRA 9 , IR50 

C 

COMMON /UNIFBD/ I R 51 , I R52, I R53, I R5A, I R55, I R56, I R57. I R58, I R59 
COMMON /SCHALR1/ NELM.NNODE.NT 
COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT, DTLAM, SGN , I PP .TROOT, ASO, SP 
COMMON /DISCT/ NDC.NDBC 
C 
C 

A I NS=0 .0 
C0EFF=50.0 
ZR=0 .0 

VL I MN0=VL I MN 
VAL=0.0 

IF (I I . EQ. 1) THEN 
VL I MN=0 .0 
DO 10 1=1, ND 

C I F (NDC.EQ.O) THEN 

TEMP=-FRCINC (I) 

C ELSE 

C TEMP=DDD(I)*R00T-FRCINC(I) 

C END IF 

C A I NS=A I NS+TEMP 

VL I MN=VL I MN+TEMP*TEMP 
IF(I.LT.U) THEN 

WRITE (6,90) 11,1 ,ZR, FRC I NC (I ) ,ACTFRC(I) 

END IF 

C WRITE (6,80) II , I ,D (I) *ROOT,FRCINC (1) ,TEMP,VAL 

C 80 FORMAT (* I I , I ,D(I) ,FRCI NC.TEMP: ' ,21 A.AF12.3) 

10 CONTINUE 

VL I MN=SQRT (VL I MN) 

VAL=VLIMN 

WRITE (6,5V) 'VAL=' ,VAL 
ELSE 

DO 20 1=1, ND 

C IF (NDC.EQ.O) THEN 

TEMP=-FRC INC (I) 


41 



c 


c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


ELSE 

TEMP*DDD ( I ) *ROOT-FRC I NC ( I ) 

END IF 

VAL=VAL+TEMP*TEMP 
A I NS=A I NS+TEMP 

IF ((I .EQ.2) .OR. (I ,EQ.7)) THEN 
IF (I.LT.10) THEN 

WR I TE ( 6 , 90 ) ( I , I ,ZR, FRO INC (I) , ACTFRC ( I ) 

END IF 

90 FORMAT*' I I , I ,D (!) ,FRCINC,ACTF: 1 .2IL.3F1L.6) 
20 CONTINUE 

VAL=SQRT (VAL) 

END IF 
I CNC1=0 

VALS=VAL*COEFF 

I F (VL I MN . GT . 1 0 .0) VL IMN= 10,0 
IF (NDC.EQ.l .AND. VLIMN.LT. 0.005) ICNC1=1 
IF (VALS.LT.VLIMNO) ICNC1«1 
WRITE (6,50) VAL*COEFF , VLIMN, I CNC1 
50 FORMAT (' VAL 1,CR I Tl.CONCL ARE: ' , 2F U .L, 1 1 3) 

RETURN 

END 


SUBROUTINE CMPTl 

CMPT1 is used to make a initial arangement of 
the real and integer vector. 

The parameters are : 

NE1M --‘• The number of elements in the shell. 

NNODE -- The number of nodes in the shell. 

NT — NNQDE*5 

ND -- The number of unknown displacements. 

NO — 2*nd 

NSTEP — Number of load steps. 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8 (I -N) 

CHARACTER TITLE*80 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT, NSTEP, NHBW, C0EF1 .C0EF2.NSH0W1 .NSH0W2, 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /MTL/ E,EU 

COMMON /LNGTH 1/ L 1 1 , L 1 2 , LI 3, L Mt , L 15, L 1 6, L 1 7. LI 8 , L 1 9, L I 10 
COMMON /LNGTHR/ LR 1 , LT2 , LR3 , LRL, LR5 , LR6, LR7 , LR8 , LR9, LR 1 0 , 

1 LR 11, LR12, LR1 3, LR1L, LR15, LR16, LR1 7, LR18, 

2 LR19, LR20, LR2 1 , LR22 , LR23 , LR2L, LR25, LR26 
COMMON /PNTRIN/ I PI , IP2, IP3, 1 PL, I P5, I P6, 1 P?. IP8, IP9, ! P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, IRL, I R5, IR6, 1 R7, IR8, IR9, I RIO, 

1 I R 1 1 , 1 R 1 2, 1 R 1 3 . 1 RTL , I R 1 5 , 1 R 1 6 , 1 R 1 7 , 1 R 1 8 , 

2 IR19, IR20, IR21, IR22, IR23, IR2L, IR25, IR26, 

3 IR27, IR28, IR29, IR30, IR31,IR32, l R33. IR3L, 

L IR35, IR36, IR37, IR38, IR39, IRLO, IRLl, IRL2, 

5 IRL3, IRLL, IRL5, IRL6, IRl»7, IRL8, IRL9, IR50 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TI N IT 

COMMON /UNIFBD/ IR 51 , IR 52 , IR53, IR 5 L, IR55, IR 56 , IR57, IR 58 , IR59 

COMMON /RLVEC/ VR (1) 

COMMON /INTVEC/ IPT(l) 

COMMON /GEO/ TO 

COMMON /CONTN/ I NS I DT,KPDT,DTLM1 

COMMON /BOD/ D0,ZC0,ZC1 ,ZC2,ZC3,ZM1 ,ZM2,CA1 ,CA2,CR1 ,CR2,ZN0 

COMMON /WAL/ WK,WB,WN2,WN3,WNL,WN5,WN6,WN8,WN9,WN10,WN1 1 ,WRO 

COMMON /SQ/ SQQ 

COMMON /DISCT/ NDC.NDBC 

COMMON /CREEP/ I CRP,NBCRP,NBDN,CRPTM, I PON 
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COMMON /CRPC/ CRPC1 , CRPC2 

COMMON /TMPEF/ I DO , NTEM.N ITR, NANM, CEXPN ,TMMI N.TMI NC,TMMAX,TMPP 
COMMON /OUTVR/ NPT.NPV 

READ (5,*) NELM.NNODE.NSTEP, ITRLM,E,EU,TO,COEFl ,C0EF2, FACTOR, 

1 NSHOW1 ,NSHOW2,NSHOW3, I NS I DT , KPDT, DTLM 1 , SQQ 

WRITE (6,20) NELM, NNODE 

20 FORMAT ('THE NUMBER OF ELEMENTS IS:', II 3,' THE NUMBER OF NODE IS 

1 ,m) 

R E A 0 (5 , *) I D 0 , NT E M , N I TR , N ANM , CE X PN , TMM I N , TM I NC.TMMAX 

READ (5,*) NCONS, MODEL, ETAA.TDELT 

T I N IT=TDELT 

READ (5,*) I CRP, NBCRP 

READ (5,*) NPT.NPV 

CRPC 1=1 .0 

CRPC2—1 .0 

IF (NCONS.EQ.O.AND. ICRP.EQ. 1) THEN 

WRITE (6,*) 'ELASTIC MODEL CAN NOT BE USED TO CALCULATE CREEP, 

1 STOP* 

STOP 
END IF 

M0DEL=1 ..BODNER, M0DEL=2 . .WALKER 
RE AD (5 , *) DO , ZCO , ZC 1 , ZC2 , ZC3 , ZMl , ZM2 , CA 1 , CA2, CR 1 , CR2 , ZNO 
READ (5,*) WK,WB,WN2,WN3,WN4,WN5,WN6,WN8,WN9,WN10,WN11 ,WRO 
NE8=NELM*8 
ND3=NNODE*3 
ND5=NN0DE*5 
NT=ND5 

ND5S=ND5*ND5 

LI 1=NE8 
LI2=ND5 
L I 3=ND5 
LIA=ND5 
L I 5=ND5 
L I 6=NELM 
LI7=NELM 
LI 8=NELM*40 
L I 9=NDBC 
LI 10=NDBC 

LR1=NN0DE 

LR2=NN0DE 

LR3=NN0DE 

LR4=ND5 

LR5=ND5 

LR6=ND5 

LR7=NSTEP 

I Pl = l 

IP2-IP1+LI 1 
I P3=l P2+L I 2 
I P4.= l P3+L 1 3 
I P5=l P4+L 1 4 
IP6=IP5+LI5 
I P7=l P6+L 1 6 
I P 8 =l P 7 +L 1 7 
I P9=l P8+L 1 8 
I P 1 0 = I P 9 +L 1 9 
1 PI 1=1 P10+L 1 10 

WRITE(6,*) 'NUMBER OF I NTEGER: ' , I PI 1 
I Rl = l 

I R2=l R1+LR1 
I R3= I R2+LR2 
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IR4=IR3+LR3 
I R5=l R4+LR4 
IR6=IR5+LR5 
!R7=IR6+LR6 
IR8=1R7+LR7 

RETURN 

END 


CMPT2 is used to make a mamory arangement of 
the real and integer vector. 


C 

C 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 


c 


SUBROUTINE CMPT2 
The parameters are : 

NELM — The number of elements in the shell. 

NNODE — The number of nodes in the shell. 

NT — NNode*5 

ND — The number of unknown displacements. 

NO — 2*nd 

NSTEP — Number of load steps. 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT I NTEGER*8 (I -N) 

CHARACTER TITLE*80 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /SCHALR2/ NEQT, NSTEP, NHBW, C0EF1 , C0EF2 , NSH0W1 .NSH0W2, 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /MTL/ E,EU 

COMMON /LNGTH I / L1 1 , L 1 2, L 1 3. LI 4, L 1 5. L 1 6, L 1 7 , L I 8, L 1 9, L1 10 
COMMON /LNGTHR/ LR1 , LT2 , LR3 , LR4 . LR5, LR6, LR7 , LR8 , LR9, LR 10 , 

1 LR11,LR12,LR13,LRH,LR15,LR16.LR17.LR18, 

2 LR1 9. LR20, LR21 , LR22 , LR23.LR24.LR25.LR26 
COMMON /PNTRIN/ I PI , I P2 , 1 P3, 1 P4, I P5. 1 P6, 1 P7, 1 P8, 1 P9. 1 P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, IR7, IR8, IR9, I RIO, 

1 IR11, IR12JR13. IR14, IR15. IR16.IR17.IR18, 

2 IR19, 1R20, IR21, IR22, IR23» IR2l», IR25, I R26 , 

3 IR27, IR28, IR29, IR30. IR31 . 1R32 , IR33, IR3 1 *, 

b IR35» IR36. IR37 , I R38, IR39, IR^O, IR41, IR42, 

5 IR43, IR44, IR45, IR46, IR47, IR48, IR49, IR 50 

COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ I PT { 1 ) 

COMMON /UNIFBD/ IR51 . IR52, IR53, IR54, IR55, IR56, IR57, IR58. IR59 

COMMON /DIRCS/ IR60, IR6l , IR62, IR 63 . f R64, IR 65 

COMMON /DISCT/ NDC.NDBC 

COMMON /D I SVC/ IR66, IR 67 , IR68, IR 69 

COMMON /DISV1/ IR70,IR71,IR72,IR73.IR7 1 »,IR75 


ne8=nelm*8 

ND3=NNODE*3 

ND5=NN0DE*5 

NT=ND5 

ND5S=ND5*ND5 

LI 1=NE8 

LI2=ND5 

LI3=ND5 

LI4=ND5 

LI5=ND5 

L I 6=NELM 

LI7=NELM 

LI8=NELM*40 


C 
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LR8=NEQT 

LR9=ND5 

LR10=ND5 

LR1 1=ND5 

LR12=ND5 

LR13=ND5 

LRH=ND5 

LR15=ND5 

LRl6=ND5 

LR1 7=NEQT 

LRl8=ND5 

LR19=ND5S 

LR20=NELM*72 

LR21=l600 

LR22=40 

C LR23=NEQT*(NEQT+1)/2 
LR23=1 

C LR23 is for P(l), if use skylight, then active it. 
LR24=NEQT*NEQT 
LR25=1600 
LR26=ND5 
LR27=ND5 
LR28=1600 
LR29=1600 
LR30=1600 
LR31=36 o 
LR32=360 
LR33=360 
LR3^=8l 
LR35=8l 
LR36=36 
LR37=36 
LR38=3& 

LR39=36 
LR40=36 
LRif 1 = 1 

C LR41=LR23 
LR42=ND5 
lrL3=nnode 

LR44=NN0DE 
LR45=NN0DE 
LR46=ND5 
LR47=NELM*72 
LR48=ND5 
LRl*9=ND5 
LR50=ND5 
LR51=NELM*96 

2 * 2 * 2 * 12=96 FOR BOTH BODNER AND WALKER'S MODEL 
64=2*2*2* (6+1) 6=BETA(!,J) 7=Zi (THE STATE VARIABLE FOR 

BODNER' S MODEL 
LR52=ND5 
LR53=6 

LR54=NELM*8*24*6 
LR55=NELM*8*24 
LR56=NELM*8*6 
LR57=NELM*8*36 
LR58=NELM*8*12 
LR59“ND5 
LR6o=NN 0DE*3 
LR6l =NNODE*3 
LR62=NNODE*3 
LR63=NN0DE*3 
LR64=NNODE*3 
LR65=NNODE*3 
LR66=NDBC*NDBC 
LR67=NDBC*NEQT 
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LR68=LR67 
LR69=NDBC 
LR70=NDBC 
LR7 1=NDBC 
LR72=NDBC 
LR73=NDBC 
LR74=NDBC 
LR75=NDBC 


I P 1 = 1 

IP2=IP1+U 1 
IP3=IP2+LI2 
I P4=l P3+L 1 3 
I P5= I P4+L I 4 
I P6= I P5+L 1 6 
I P 7 -I P 6 +L 1 7 
IP8=IP5+LI5 
I P9=l P 8 +L 1 8 


IR9=IR8+LR8 
I R 10= I R9+LR9 
I R 1 1 = IR10+LR10 
IR12=IR1 1+LR1 1 
I R1 3 = I R1 2+LR1 2 
I Rl4=l R1 3+LR1 3 
I R 15= I R 1 4+LR 1 4 
I Rl6=l R15+LR15 
I R17=l R16+-LR16 

IRI8-IRI7+LRI7 

IR19=IR18+LR18 
IR20=1R19+LR19 
I R2 1 = 1 R20+LR20 
I R22=l R2 1+LR2 1 
I R23=l R22+LR22 
I R24= I R23+LR23 
I R25=l R24+LR24 
I R26=l R25+LR25 
I R27=l R26+LR26 
1 R28= I R27+LR27 
1R29=IR28+LR28 
IR30=1R29+LR29 
IR31-IR30+LR30 
IR32=IR31+LR31 
I R33= I R32-+LR32 
IR34=IR33+LR33 
IR35=IR34+LR34 
IR36=IR35+LR35 
IR37=IR36+LR36 
IR38=IR37+LR37 
IR39 = s IR 38+LR38 
I R40=l R39+LR39 
IR4l=IR40+LR40 
IR42=IR4l+LR4l 
IR43=IR42+LR42 
IR44-IR43+LR43 
IR45=IR44+LR 44 
IR46=IR45+LR45 
I R47 ss l R46+LR46 
I R48=l R47+LR47 
IR49=1R48+LR48 
IR50=IR49+LR49 
I R51=l R50+LR50 
IR52=IR51+LR51 
1 R53=l R52+LR52 
IR54=IR53+LR53 

IR55=IR54+LR54 46 
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I R56= I R55+LR55 
IR57=IR56+LR56 
IR58=IR57+LR57 
IR59=IR58+LR58 
I R60=l R59+LR59 
IR6l=IR60+LR60 
I R62=l R61+LR61 
IR63=IR62+LR62 
IR64=IR63+LR63 
IR65=IR64+LR64 
I R 66 =l R 65 +LR 65 
I R67= I R 66 +LR 66 
IR68=IR67+LR67 
I R 6 g=l R 68 +LR 68 
IR70=IR69+LR69 
IR71=IR70+LR70 
IR72=IR71+LR71 
I R73“l R72+LR72 
IR74=IR73+LR73 

IR75=IR7U+LR7l* 

C 

WRITE (6,*) 1 INTEGER 3 ' , IP9 

MEM0R=IR75+LR75 

IF (MEMOR. LT.MAXR) THEN 

WRITE ( 6 ,*) 'THE PREDIFINED MEMORY IS NOT ENOUGH . 1 
WRITE ( 6 ,*) 'MEMORY: ' .MEMOR 
STOP 
END IF 

WRITE ( 6 ,*) 'MEMORY: '.MEMOR 
IF (MEMOR. GT. 100) STOP 

RETURN 
END 
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Subroutine Bolsul is the solution phase using Bodner's constitutive 
equation. 

Inputs are: 

BL used to find the local strain. 

VFE the displace increament. epsl n*bl .vf e 

SVT3D and SVBLD are the data calculated in the processing face. 

State variable BETA (. .7) (1 , . 6 -directiona] , 7” isotropic) are updated. 
The derivative of the state variables STVDF and the derivative of the 
nonlinear strain EPSND are calculated. 

The stress increament is also calculated. 


***************************************************************************** 


CALL BODSUL (IL, I I ,JJ,KK,VR (IR31) ,VR(IR29) ,VR(IR54) , 

1 VR (IR55) ,VR(IR51) ,SD,VR(IR56) , VR (IR57) ) 

SUBROUTINE BODSUL (I AA, IA, IB, 1C, BL, VFE, SVT3D, SVBLD, BETA, SD, 

1 BDSV.EM4, AA) 

C 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER* 8 (I-N) 

DIMENSION BL ( 6 , AO) ,VFE (1) , SVT3D (NELM, 2 ,2,2,1 44) .TMVEC (24) , 

1 SVBLD (NELM, 2. 2, 2, 24) , BETA (NELM, 2, 2, 2, 12) ,SD(6,1) , 

2 BDSV (NELM, 2, 2, 2, 6 ) ,EM4 (NELM, 2, 2, 2, 36) , 

3 DLBET( 6 ) ,TMV(19) ,AA(6,1) 

C 


COMMON /SCHALR1/ NELM.NNODE.NT 

COMMON /SCHALR2/ NEQT,NSTEP,NHBW,C0EF1 ,C0EF2,NSH0W1 .NSH0W2, 
1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRIN/ 1 PI , I P2 , 1 P3 , 1 P4 , 1 P5 , 1 P6 , 1 P7 * I P8 , 1 P9 , 1 P 10 
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COMMON /PNTRRL/ IR1, IR2, IR3, I R4, I R5, I R6, IR7, IR8, IR9, IRlO, 

1 IR11, 1 R12, iR13,IRH*,IR15, IR16, IR17, IRl8, 

2 1 R 1 9 , IR20, IR21 , 1 R22 , 1 R23» I R24, I R25 , I R26, 

3 IR27, IR 28 , IR29, IR30, IR31 , 1 R32, IR33, IR34, 

4 l R35 , 1 R36 , 1 R37 , 1 R38 , 1 R39 . 1 R«M R4 1, 1 R42, 

5 IR43, IR44.IR45.IR46, IR47, IR48.IR49.IR50 
COMMON /RIVEC/ VR (1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT.DTLAM.SGN, I PP.TROOT, ASO.SP 

COMMON /GEO/ TO 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ i NS I DT.KPDT, DTLM1 

COMMON /UNICT/ NCONS, MODEL, ETAA.TOELT, TIN IT 

COMMON /UNIFBD/ IR51 , I R52 , IR53.IR54.IR55, IR5&. IR57, IR58, IR59 

COMMON /BOD/ DO.ZCO.ZCI ,ZC2,ZC3,ZM1 .ZM2.CA1 .CA2.CR1 .CR2.ZN0 

COMMON /CREEP/ I CRP.NBCRP.NBDN, CRPTM, I PON 

I PR=0 

IF ((IA.EQ.1) .AND. (IB.EQ.l) .AND. (IC.EQ.1)) I PR* 1 


59 FORMAT (6F 12.4) 

C if(ipr.eq.l) then 
C do 220 i=l ,19 

C wr i te (6,59) (-svt3d (iaa, i a, lb, ic, i *6-6+j) , j = l ,6) 

C220 continue 
C end i f 

DO 80 1=1,19 
TMVEC (I) =0.0 
DO 80 J=1 ,6 

TMVEC ( I ) =TMVEC ( I ) -SVT3D ( I AA , I A , I B , I C , I *6-6+J) *AA (J , 1) 

80 CONTINUE 

C If(ipr.eq.l) write (6,*) 1 vbld, tmv, tmvec in FACE 2: ' 

DO 60 1=1 ,19 

TMV (I ) =TMVEC (I) 

TMVEC (I ) =SVBLD (I AA, I A. I B, IC, I ) +TMVEC (I ) 

IF (IPR.EQ.l) then 

wr i te (6 , >’«) I,' 1 ,svb1d (iaa, ia, ib, ic, i) , 1 1 ,TMV (I) , 1 ' , tmvec ( i ) 

end i f 

60 CONTINUE 
C 

DO 100 1=1,6 
SD (1,1) =TMVEC ( I ) 

DLBET (I ) =TMVEC (1+13) 

C WRITE (6,*) I,' D (Zd/DT) : ' ,STVDF (IAA, I A, IB, IC, I) 

100 CONTINUE 
C 

C IF (IPR.EQ.l) THEN 

C WRITE (6,*) 'PUELAS:' 

C WRITE (6,8) (TMV (I) ,1 = 1,6) 

C WRITE (6,8) (SD (1,1), 1=1, 6) 

C 8 FORMAT (6F 12.8) 

C END IF 

C 

DO 120 1=1,6 

BETA (IAA, I A, I B, I C, I) =BETA (IAA, I A, I B, I C, l)+DLBE+ (I) 

I F (BETA (IAA, I A, IB, I C, I) .GT.ZC3) BETA (IAA, IA, IB, IC, I) =ZC3 
I F (BETA ( I AA, I A , I B , I C, I ) .LT.-ZC3) BETA (IAA, I A, IB, IC, I) =-ZC3 
C WRITE (6, *) I,' BETA: ' .BETA (IAA, IA, IB, IC, I) 

120 CONTINUE 

BETA (IAA, I A, IB, I C, 7) =BETA (I AA, I A, IB, I C, 7) +TMVEC ( 1 3 ) 

I F (BETA (IAA, I A, IB, IC,7) .GT.ZC1) BETA (IAA, I A, IB , I C , 7) =ZC 1 
IF (BETA (IAA, IA, I B, IC,7) .LT. (2.0*ZC0-ZC1) ) BETA (I AA, I A, I B, IC,?) = 

1 2.0*ZC0-ZC1 

C if(ipr.eq.l) WRITE (6,*) '8 =Zi BETA: ' .BETA (IAA, I A, IB, IC, 7) 

C 
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STVDF (1) is the dirivative of the undi recti onal variable. 
BETA (7) is the und i rect i onal variable. 

RETURN 

END 

END (BODSOL) 
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C * Subroutine Bodner is to prepare the stiffness matrix and the * 
C * residure force. Input is the state variable and current stress. * 
C * Output is EM2 (to form stiffness matrix by cb) , BDLD * 
C * (to form the force term by cb) , SVT3D and SVBLD (wi l l be used * 
C * in the sulution face) * 
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c 

c 

SUBROUTINE BODNER (I I I , IAA.IA, IB, IC,SIG,ZZZ,EM2,S, BETA, BDLD, 

1 SVT3D , SVBLD , ZZR , BDSV, EMA , A I NV) 

C 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION SIG(3,3) ,ZZZ(19J9) ,EM2 (6,6) , S (3 , 3) .BETA (NELM, 2, 2, 2, 12) , 

1 BDLD (1) , SVT3D (NELM, 2, 2, 2, lAA) .SVBLD (NELM, 2,2,2, 2A) , 

2 ZZR (19,6) ,VE Cl (19) ,VCTL(19) ,GA (19) , BETA A (7) , A I NV (1) , 

3 VEPS (6) ,SS (6) , SECTM (6) ,T3D (19,6) .VEPSLN (3,3) , 

A BDSV (NELM, 2, 2, 2,6) ,EMA (NELM, 2, 2, 2, 36 ) ,SIGVC(6) 

5 , AAA (6,6) , BBB (6,6) , CCC (6 , 6) ,DDD (6,6) ,VECC(19) 

C 

COMMON /BOD/ D0,ZC0,ZC1 ,ZC2,ZC3, ZM1 , ZM2.CA1 , CA2.CR1 , CR2.ZN0 
COMMON /UNICT/ NCONS .MODEL, ETAA,TDELT,TI N IT 
COMMON /UNIFBD/ I R51 , I R52, I R53, I R5A, l-R-55 • IR56, IR57, IR58, IR59 
COMMON /SCHALR1/ NELM,NNODE,NT 

COMMON /SCHALR2/ NEQT, NSTEP , NHBW, COE F 1 , C0E.F.2 , NSH0W1 , NSH0W2 , 

1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRI N/ I PI , I P2, I P3, 1 PA, I P5, I P6, I P7, I P8, I P9, I P10 
COMMON /PNTRRL/ IR1, IR2, IR3.IRA, IR5, I R6 . IR7, I R8, IR9, I RIO, 

1 IR1 1 , I R 1 2 , 1 R 1 3 , I R 1 A , I R 1 5 , 1 R 16 , IR17, 1 R 1 8 , 

2 IR19, IR20.IR21 , IR22, IR23, IR2A, IR25, IR26, 

3 IR27, IR28.IR29, IR30, IR31, IR32, IR33, I R3A, 

A IR35, IR36, IR37, IR38, I R39 . I R^O, IRAl , IRA2, 

5 IRA3, IRAA, IRA5, IRA 6 , IRA7, IRA 8 , IRA9, IR50 

C 

COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT, DTLAM.SGN, I PP.TROOT, ASO.SP 

COMMON /GEO/ TO 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ I NS I DT, KPDT, DTLM1 

COMMON /ABDFST/ I SEC 

COMMON /NCTT/ NCT (12,2,2,2) 

COMMON /NMBITR/ NUM 
C 
C 

C ZNO , DO are input constants in kinematical equation. 

C 

C ACS,ZC1 ,ZC2,ZC3,CM1 ,CM2,CR1 ,CR2 are constants in state variable equations. 
C S(i,j) is the stress deviator 
C DJ2=1/2*S (I ,J)*S (I , J) 

C SJ2-SIG (I * J) *SIG (i , J) 

C ZVl=Zi 

C SIGM(6) — SIG (3,3) 

C VSTV=D (Z) /DT 

C VSTV1=D (ZV1) /DT 

C 

C ET=-ETA*TDELT where eta and del tat are given. 
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I PR=0 

IF ((IA.EQ.1) .AND. (IB.EQ.1) .AND. (1C.EQ.1)) IPR=1 
C 

DO 20 1=1,7 

BETAA (I) “BETA (I AA, I A, I B, 1C, I) 

20 CONTINUE 

C WRITE (6,*) 'NUM“',NUM 

IF ((NUM.EQ. 1 .OR. NUN. EQ.2) .AND . (I NS I DT.NE . 1) ) THEN 
BETA (I AA, I A, I B, i C, 7) =ZCO 
ZV1=ZC0 
ELSE 

ZV1=BETA (I AA, I A, I B, 1C, 7) 

END IF 
C 

ET=-ETAA*TDELT 

C 

S A V- (SIG (1 , D+SIG (2, 2) +S I G (3 , 3))/3 .0 
C 

C IF (IPR.EQ.1) THEN 

C WRITE (6,*) 'SIGMA IN B0DNER' 

C DO 80 1=1,3 
C WRITE (6,32) (SIG (I ,J) , J=1 , 3) 

C 80 CONTINUE 
C 32 FORMAT (3F12.4) 

C END IF 

C 

DO 90 1=1,3 
DO 90 J-1,3 

IF(I.EQ.J) THEN 
S(l , J) =SIG (I , J) -SAV 
ELSE 

S ( I , J) »S IG ( I , J) 

END IF 
90 CONTINUE 
C 

DJ2=0.0 
SJ 2=0,0 
C 

DO 100 1=1,3 
DO 100 J=1 ,3 

DJ2-DJ2+0 . 5*S ( 1 ,J) *S ( 1 , J) 

SJ2=SJ2+S I G (I , J) *SIG (I , J) 

100 CONTINUE 

IF (IPR.EQ.1) WRITE (6, *) *DJ2,SJ2 IS: '.DJ2.SJ2 
C 

C ZZ is state variable. ZZ=Zi+Zd 
C Now calculate ZD and ZZ 
C 

ZD=0.0 

ZD=S I G (1 , 1) *BETAA (1)+SIG (2,2) *BETAA (2)+S IG (3, 3) *BETAA (3) 

1 +2* (SIG (1 , 2) *BETAA (h) +S I G (2 , 3) *BETAA (5) +S IG ( 1 , 3) *BETAA (6) ) 

ZD=ZD/SJ2**0.5 
ZZ=ZV1+ZD 
ZZ2=ZZ*ZZ 
IF (IPR.EQ.1) THEN 

WRITE (6, *) ' STATE VAR Z I , Z 0, ZZ ' , ZV1 , ZD , ZZ 
END IF 
C 

C WRITE (6,*) ' CONTTOL VAR: ' ,0.5* (ZZ2/DJ2/3.0) **ZN0 
I F ( (0.5* (ZZ2/DJ2/3-0) **ZNO) .GT.60) THEN 
FAC 1=0.0 
ELSE 

C WRITE (6,*) ' COMMING 1 

FAC1=D0* (EXP (-0.5* (ZZ2/DJ2/3.0) **ZNO) ) /DJ2**0.5 
END IF 
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DO 1*0 1-1,3 
DO 40 J=1 , 3 

VEPSLN (I , J) -S (1 , J) *FAC1 
40 CONTINUE 

VEPS < 1 ) -VEPSLN (1,1) 

VEPS (2) =VEPSLN (2,2) 

VEPS (3) =VEPSLN (3,3) 

VEPS (It) =VEPSLN (1,2) 

VEPS (5) =VEPSLN (2,3) 

VEPS (6) -VEPSLN (1,3) 

NCT (I AA, I A, IB, IC)=1 

i f ( i pr .eq . 1) then 
C write (11,*) 

C end i f 

C wr i te (1 1 ,253) (veps (i) , i = l ,6) 

253 FORMAT (6F 12. 10) 

VEPSLN (1,1) -VEPS (1) 

VEPSLN (2,2) -VEPS (2) 

VEPSLN (3 . 3) =VEPS (3) 

VEPSLN (1 ,2) -VEPS (1*) 

VEPSLN (2,3) =VEPS (5) 

VEPSLN (1,3) -VEPS (6) 

C 

SS (1) =S (1 , 1) 

SS (2) — S (2,2) 

SS(3) =S (3,3) 

SS (1*) =S (1,2) 

SS (5) =5 (2,3) 

SS (6) =S (1,3) 

C 

S I GVC (1) -S I G (1 , 1) 

SIGVC (2)=SIG (2,2) 

S I GVC (3) — S I G (3,3) 

SIGVC (4) =S I G (1 , 2) 

SIGVC (5) -S I G (2,3) 

SIGVC (6) -SIG (1 ,3) 

C 

FAC1=FAC1*ET 

C Now -eta*deltat is included in the formula in first 6*6 matrix. 
C 

FAC2=ZZ2*ZN0* (ZZ2/DJ2/3 . 0) ** (ZNO- 1 . 0) /6 . 0/DJ2/D J2-0 . 5/D J 2 
FAC 3-F AC 1 *F AC2 

F AC4— F AC 1 *ZNO* (1/3.0/DJ2) **ZNO* (ABS (ZZ) ** (2.0*ZN0-1 .0) ) 

IF (ZZ.GT.O.O) THEN 
FAC4-FAC4 
ELSE 

FAC4— FAC4 
END IF 
C 

FAC5=FAC4/(SJ2)**0.5 

C 

CALL MNU(19,19,ZZZ) 

C 

ZZZ (7, 1) -FAC1* (2.0/3.0+S (1 , 1) *S (1 , 1) *FAC2) 

ZZZ (7,2) -FAC1* (-1 .0/3.0+S (1 , 1) *S (2,2) *FAC2) 

ZZZ (7,3) -FAC 1* (-1 .0/3.0+S (1 , 1) *S (3,3) *FAC2) 

ZZZ (7 , 4) -F AC3*S (1,1) *S (1 ,2) 

ZZZ (7.5) “FAC3*S(1,1)*S (2,3) 

ZZZ (7,6) =FAC3*S(1,1)*S(1,3) 

C 

ZZZ (8, 1) -FAC 1* (-1 .0/3.0+S (2,2) *S (1,1) *FAC2) 

ZZZ (8 , 2) =F AC 1 * (2 .0/3 . 0+S (2 , 2) *S (2 , 2) *F AC2) 
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ZZZ (8 , 3) =F A C 1 * (- 1 . 0/3 • 0+S (2 , 2) *S (3 , 3) *F AC2) 
ZZZ (8 , 4) =F AC3*S (2,2) *S (1 ,2) 

111 (8 , 5) -F AC3*S (2 , 2) *S (2 , 3) 

ZZZ (8 , 6) =F AC3*S (2 , 2) *S (1 , 3) 

C 

111 (9, 1) =FAC1* (-1 .0/3- 0+S (3.3) *S (1 , 1) *FAC2) 
111 (9 , 2) =F AC 1 * (- 1 .0/3 .0+S (3,3) *S (2 , 2) *F AC2) 
ZZZ (9 , 3) =F AC 1 * (2 . 0/ 3 • 0+S (3 , 3) *S (3 , 3) *F AC2) 
111 (9,4) -F AC3*S (3, 3) *S (1 , 2) 

ZZZ (9,5) =FAC3*S (3,3) *S (2,3) 

ZZZ (9,6) =FAC3*S (3, 3) *S (1 , 3) 

c 

ZZZ (10, 1) =FAC3*S (1,2) *S (1 , 1) 

ZZZ ( 1 0 , 2) =F AC3*S (1 , 2) *S (2 , 2) 
ZZZ(10,3)=FAC3*S(1,2) *S (3,3) 

ZZZ (10,4) =FAC1* (1+S (1 ,2) *S (1 ,2) *FAC2) 

ZZZ ( 10,5) -F AC 3*S (1 , 2) *S (2 , 3) 

ZZZ (10,6) =FAC3*S (1 ,2) *S (1 ,3) 

C 

111 (11,1) =FAC3*S (2,3) *S (1 , 1) 

ZZZ (1 1 , 2) =FAC3*S (2,3) *S (2,2) 

ZZZ ( 1 1 , 3) =F AC3*S (2 , 3) *S (3 , 3) 

ZZZ (1 1 ,4) =FAC3*S (2,3) *S (1 ,2) 

ZZZ ( 1 1 , 5) -F AC 1 * (1+S (2 , 3) *S (2 , 3) *F AC2) 

ZZZ ( 11,6) =F AC3*S (2 , 3) *S ( 1 , 3) 

C 

ZZZ (12, 1) =FAC3*S (1,3) *s (1 , 1) 

ZZZ ( 1 2 , 2) =F AC3*S ( 1 , 3) *S (2 , 2) 

ZZZ (12,3) = F AC3*S (1,3) *S (3 , 3) 

ZZZ (12,4) =FAC3*S (1,3) *S (1,2) 

ZZZ (12,5) *FAC3*S (1,3) *S (2 , 3) 

ZZZ (12,6) =F AG 1 * (1 .0+S (1,3) *$ (1,3) *FAC2) 

C 

ZZZ (7, 7) -1.0 
111 (8,8) =1 .0 
ZZZ (9, 9) -1.0 
ZZZ (10, 10) =1 .0 
ZZZ (1 1 , 1 1) =1 .0 
ZZZ (12, 12)® 1 .0 

c 

ZZZ (7, 13) = FAC4*S (1 , 1) 

ZZZ (8,13) “FAC4*S (2,2) 

ZZZ (9,13) =FAC4*S (3,3) 

111 (10,13) =FAC4*S (1,2) 

ZZZ (1 1,13) *FAC4*S (2,3) 

ZZZ (12, 13) “F AC4*S (1,3) 

C 

111 (7,14) =FAC5*S (1 , 1) *SIG (1 , 1) 

ZZZ (8,14) =F AC5*S (2 , 2) *S I G ( 1 , 1 ) 

111 (9,14) =FAC5*S (3,3) *S1G (1 , 1) 

ZZZ (10, 14) =FAC5*S (1,2) *SIG (1 , 1) 

111 (11, 14) =FAC5*S (2,3) *SIG (1 , 1) 

ZZZ (1 2 , 14) «FAC5*S (1 , 3) *S I G (1 , 1) 

C 

ZZZ (7, 15) =FAC5*S (1 , 1) *SIG (2,2) 

111 (8,15) =FAC5*S (2,2) *S IG (2,2) 

ZZZ (9,15) =F AC5*S (3 , 3) *S I G (2 , 2) 

ZZZ ( 1 0 , 1 5) =F AC5*S ( 1 , 2) *S I G (2 , 2) 

ZZZ ( 11 , 1 5) =F AC5*S (2 , 3) *S 1 G (2 , 2) 

ZZZ ( 1 2 , 1 5) -F AC5*S (1,3) *S I G (2 , 2) 

C 

111 (7,16) =FAC5*S (1 , 1) *S I G (3, 3) 

ZZZ (8,16) =F AC5*S (2 , 2) *S I G (3 , 3) 

ZZZ (9,16) =F AC5*S (3 , 3) *S I G (3 , 3) 

111 ( 1 0 , 1 6) =F AC5*S ( 1 , 2) *S I G (3 , 3) 

ZZZ ( 1 1 , 1 6) =F AC5*S (2 , 3) *S I G (3 , 3) 


52 



ZZZ o 2 , 1 6) =F AC5*S ( 1 , 3) *s I G (3 , 3) 

C 

111 (7,17) =FAC5*S (1 , 1) *SIG (1 ,2) 

111 (8,17) =FAC5*S (2,2) *S I G (1,2) 

ZZZ (9 , 1 7) =F AC5*S (3 , 3) *S I G ( 1,2) 

ZZZ (10, 17) =FAC5*S (1,2) *S I G (1 ,2) 

ZZZ (11, 17) =FAC5*S (2,3) *SIG (1,2) 

ZZZ (12, 17) =FAC5*S(1,3)*SIG(1,2) 

111 (7,18) =F AC5*S (1 , 1 ) *5 1 G (2 , 3) 

ZZZ (8,18) =FAC5*S (2 ,2) *SIG (2 ,3) 

ZZZ (9,18) =F AC5*S (3 , 3) *S I G (2 , 3) 

ZZZ (10, 18)=FAC5*S (1,2) *S I G (2,3) 

111 ( 1 1 , 1 8 ) =F AC5*S (2 , 3) *S1G (2 , 3) 

ZZZ (12, 18) =FAC5*S (1,3) *SIG (2,3) 

C 

ZZZ (7 , 1 9) =F AC5*S ( 1 , 1 ) *S I G (1 , 3) 

111 (8,19) =FAC5*S (2, 2) *SI G (1 ,3) 

111 (9,19) =F AC5*S (3,3) *SIG(1,3) 

ZZZ ( 1 0 , 1 9) =F AC5*S ( 1 , 2) *S 1 G ( 1 , 3) 

111 ( 1 1 , 1 9) =F AC5*S (2,3) *S I G (1,3) 

ZZZ (12, 19) =FAC 5 *S (1,3) *SI G (1 , 3) 
c 

C Next part is -[G.epslon n] 

C 

PWR=0 . 0 
DO 150 1=1,3 
DO 150 J=1 , 3 

PWR=PWR+S I G (1 , J) *VEPSLN (I , J) 
150 CONTINUE 

C WRITE (6,*) 'PLASTIC WORK IS: ',PWR 
C 

C Row 13 is for state variable Zi . 

C 

FAC6=-ZM1*(ZC1-ZV1) 


c 

IF (IPR.EQ.l) 

THEN 


c 

WRITE (6,*) 

' FAC1 

' ,FAC1 

c 

WRITE (6,*) 

FAC2 

' , F AC2 

c 

WRITE (6,*) 

FAC3 

’,FAC3 

c 

WRITE (6,*) 

' F ACV 

' , FACA 

c 

WRITE (6,*) 

' FAC5 

' ,FAC5 

c 

WRITE (6,*) 

'FAC6 

' ,FAC6 

c 

END IF 




ZZZ (13,7) =FAC6*S I G (1 , 1) 

ZZZ (13,8) =FAC6*SIG (2,2) 

ZZZ (13,9) =F AC6*S I G (3 , 3) 

ZZZ (13, 10) =FAC6*S I G (1 , 2) *0,5 
111 ( 1 3 , 1 1 ) =F AC6*S I G (2 , 3) *0 . 5 
ZZZ (13,12) =FAC6*S I G (1 , 3) *0.5 

HI ( 1 3 , 1 3) = 1 • O+ET* (-ZM 1 *PWR- C A 1 *CR 1 * 

1 (ABS ( ( (ZV1-ZC2) /ZC1) ) ** (CR1-1 .0) ) ) 

C 

C Row 8.. 13 are for state variable Zd or BETAij. 

C The order for BETAij is as stress or strain: 11,22,33,12,23,13. 

C 

FAC7=ZC3/SJ2**0.5 
C WRITE (6,*) 'FAC? ' ,FAC7 
C 

FAC8=-ZM2* (FAC7*S I G (1 , 1) -BET A A (1) ) 

ZZZ (14, 7) =FAC8*SIG (1,1) 

111 (1A,8) =FAC8*SIG (2,2) 

ZZZ ( 1 4 , 9) =F AC8*S I G (3 , 3) 

111 (IV, 10) =FAC8*S I G (1 ,2) *0.5 
ZZZ (14,11) =F AC8*S I G (2 , 3) *0 . 5 
ZZZ (IV, 12)“FAC8*SIG(1,3) *0.5 



r 


FAC8=-ZM2* (FAC7*S I G (2,2) -BETAA (2) ) 

ZZZ ( 1 5 » 7 ) =F AC8*S I G Iff I ) 

ZZZ (15. 8) =F AC8*S I G (2 , 2) 

ZZZ 05.9) =FAC8*SIG (3,3) 

ZZZ ( 1 5 , 1 0) =FAC8*S I G ( 1 , 2) *0 .5 
ZZZ (15, 1 D =FAC 8 *S»G (2, 3) *0.5 
ZZZ (15, 1 2) -F AC 8 *S I G (1 , 3) *0 . 5 

FAC8=-ZM2* (FAC7*S 1 G (3.3) -BETAA (3)) 

ZZZ (1 6, 7) *FAC8*STG (1 ,1) 

ZZZ 06,8) =FAC8*SIG (2,2) 

ZZZ (16,9) =FAC8*STG (3,3) 

ZZZ (16,10) =FAC8*SIG(1 ,2) *0.5 
ZZZ (16,1 1> «FAC8*S I G 
ZZZ ( 1 6 , 1 2) =FAC8*S I G ( 1 ,3) *0 .5 
c 

FAC8=-ZM2* (FAC7*S I G (1 ,2) -BETAA ( h ) ) 

C 

ZZZ (17,7) =F AC8*S I G (1,1) 

ZZZ (17,8) =FAC 8 *S I G (2, 2) 

ZZZ (17.9) =FAC 8 *SIG (3,3) 

ZZZ (1 7 , 10) =FAC8*S I G (1 , 2) *0.5 
ZZZ (17,11) =FAC8*S I G (2 , 3) *0 . 5 
ZZZ ( 1 7 , 1 2) =F AC8*S I G (1 , 3) *0 . 5 
c 

FAC8=-ZM2* (FAC7*SIG (2,3) -BETAA (5) ) 

C 

ZZZ (18,7) =FAC8*SIG(1,1) 

ZZZ (18, 8) «FAC8*SIG (2,2) 

ZZZ ( 1 8 , 9) •FAC8*SI G(3,3) 

ZZZ (18,10) =F AC8*S 1 G (1 , 2) *0 . 5 
ZZZ ( 1 8 , 1 1 ) =FAC8*S I G (2 , 3) *0 . 5 
ZZZ (18,1 2) =FAC8*S I G ( 1 , 3) *0 . 5 
C 

FAC8=-ZM2* (F AC7*S I G (1 ,3) -BETAA (6) ) 

c 

ZZZ(19,7) s =FAC8*SIG(1,1) 

ZZZ ( 1 9 , 8 ) =F AC8*S I G (2 , 2) 

ZZZ (19, 9) *F AC 8 *S I G (3, 3) 

ZZZ (19, 10) =FAC 8 *SIG (1 ,2) *0.5 
ZZZ (19,1 1)=FAC8*SIG (2,3) *0.5 
ZZZ ( 1 9 , 1 2) =FAC8*S I G ( 1 , 3) *0 . 5 
C 

RBT=0.0 

C 

DO 160 1=1,3 

RBT=RBT+BETAA ( I ) *BETAA ( I ) 

160 CONTINUE 

DO 170 1=4,6 

RBT=RBT+2*BETAA (I ) *BETAA ( I ) 

1 70 CONTINUE 4 

FAC9-- ET*CA2* (ZC1** (1 .0-CR2) ) * (RBT** ( (CR2-1 .0) /2 .0) ) 
I F (ABS (RBT) . IT . 0 . 0000000001 ) THEN 
FAC 10=0.0 
ELSE 

FAC10-FAC9* (CR2-1 .0) /RBT 
END IF 
C 

C WRITE (6,*) 'FAC9: ' ,FAC9, 1 FAC 10: '.FAC10 
EPT=-ET*PWR*ZM2 
C 
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no o o o o o o o o o o o o o 


ZZZ (14,14)=FAC10*BETAA (1) *BETAA (1)+1 .0+FAC9+EPT 
ZZZ (14, 15) =FAC10*BETAA (1) *BETAA (2) 

ZZZ (14, 16)=FAC10*BETAA 0) *BETAA (3) 

ZZZ (14, 17) =FAC10*BETAA (1) *BETAA (4) 

ZZZ (14,18) =FAC10*BETAA (1) *BETAA (5) 

ZZZ (14, 19) =FAC10*BETAA (1) *BETAA (6) 

C 

ZZZ 05, 14)=FAC10*BETAA (2) *BETAA (1) 

ZZZ (15, 15)=FAC10*BETAA (2) *BETAA (2)+l .0+FAC9+EPT 
ZZZ (15*16) =F AC 1 0*BETAA (2) *BETAA (3) 

ZZZ (1 5 , 1 7) =F AC 10*BETAA (2) *BETAA (4) 

ZZZ ( 1 5 , 1 8) =F AC 1 0*BETAA (2) *BETAA (5) 

ZZZ (15, 19) =FAC10*BETAA (2) *BETAA (6) 

ZZZ (16, 14)=FAC10*BETAA (3) *BETAA (1) 

ZZZ 06,15) =FAC10*BETAA (3) *BETAA (2) 

ZZZ (16, 16) =FAC10*BETAA ( 3 ) *BETAA (3)+l .0+FAC9+EPT 
ZZZ (16, 17)=FAC10*BETAA (3) *BETAA (4) 

ZZZ (16, 18) =FAC10*BETAA (3) *BETAA (5) 

ZZZ 06, 19) =FAC10*BETAA (3) *BETAA (6) 

C 

ZZZ 07, 14)=FAC10*BETAA (4) *BETAA (1) 

ZZZ (1 7, 15) =FAC10*BETAA (4) *BETAA (2) 

ZZZ (1 7 , 1 6) =F AC 1 0*BETAA (4) *BETA A (3) 

ZZZ (17, 17)=FAC10*BETAA (4) *BETAA (3)+l .0+FAC9+EPT 
ZZZ 07, 18)=FAC10*BETAA (4) *BETAA (5) 

ZZZ (17,19) =FAC10*BETAA (4) *BETAA (6) 

C 

ZZZ (18,14) =FAC10*BETAA (5) *BETAA (1) 

ZZZ (18, 15) =FAC10*BETAA (5) *BETAA (2) 

ZZZ 08, 16) =FAC10*BETAA (5) *BETAA (3) 

ZZZ (18, 17) =FAC10*BETAA (5) *BETAA (4) 

ZZZ (18, 18) =FAC10*BETAA (5) *BETAA (5)+l .0+FAC9+EPT 
ZZZ 08, 19) =FAC10*BETAA (5) *BETAA (6) 

C 

ZZZ 09,14) =FAC10*BETAA (6) *BETAA (1) 

ZZZ ( 1 9 , 1 5) =F AC 1 0*BET A A (6) *BETAA (2) 

ZZZ (19, 16) «FAC10*BETAA (6) *BETAA (3) 

ZZZ (19, 17)=FAC10*BETAA (6) *BETAA (4) 

ZZZ ( 19 , 18 ) =FAC10*BETAA (6) *betaa ( 5 ) 

ZZZ (19, 19) =FAC10*BETAA (6) *BETAA (6)+l .0+FAC9+EPT 

Equation Zi+BETA (I , J) *U (I , J) =Z in increamental form. 


ZZZ (14, 1 3 ) -1 .0 
SJR=1 . 0/S J 2**0. 5 


ZZZ(1,1)=1.0 
ZZZ (2, 2) =1.0 
ZZZ (3, 3) =1.0 
ZZZ (4,4) =1 .0 
ZZZ (5, 5) =1.0 
ZZZ (6,6) = 1 .0 

DO 333 1=1,6 
DO 333 J=1 ,6 

ZZZ ( I , J+6) =EM2 (I , J) 
333 CONTINUE 


Now the matrix [zzz] is formed. 
Next step is to find vector part. 
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VCTL ( I . .6) is the difference of d(epslon)/dt and f. 


DO 200 1=1,6 

VEC 1 (1+6) =TDELT*VEPS ( I ) 

.200 CONTINUE 

C SHCTM(i) is (G , eps 1 on*d (eps 1 on) /dt) 

00 220 1=1,7 
SECTM (I ) =0.0 
DO 220 J=1 ,6 

ZZZ (1 + 12, J+6) =0.0 

S E CTM ( I ) =S E CTM { I ) +ZZZ ( I + 1 2 , J+6) *VE PS ( J ) 

C SECTM ( I ) =SECTM ( I ) +ZZZ (1 + 12, J+6) *EPSND { I A A , I A, I B , I C , J) 

220 CONTINUE 

C 

C IF(IPR.EQ.l) THEN 

’ WRITE (6,*) ' VEPS: ' 

: WRITE (6,211), (VEPS ( I ) , I =1 , 6) 

L DO 210 1=1,7 

>' WRITE (6,211) (ZZZ (1+12, J+6) , J=1 ,6) 

210 CONTINUE 
: 211 FORMAT (6F 13.4) 

•; WRITE (6,*) 1 PWR= ' , PWR 

C END IF 

C GA is the state variable g, 

C 

GA (1) =ZM1* (ZC1-ZV1) *PWR-CA 1 *ZC 1 *ABS ( ( (ZV1-ZC2) /ZC1) ) **CR1 
C IF (IPR.EQ.l) THEN 

C WRITE (6,*) ' ZM1 = ' ,ZM1 , 1 ZC1 = \ZC1»' ZV1=',ZV1 

C WRITE (6,*) 1 ZM2»' , ZM2, ' ZC3=' ,ZC3 

C END IF 

C WRITE (6,*) ' GA (!) “Zi i" ' , GA (l) 

DO 240 1=1,6 

GA ( 1 + 1) =ZM2* (ZC3*S I GVC ( I ) /S J 2**0 . 5 ~ B ET A A ( I ) ) *PWR+F AC9*BET AA ( I ) /ET 
240 CONTINUE 
C 

C VCTL (7.. 13) is the difference between the derivative of the 
C 

DO 280 1=1,7 

VEC 1 (1 + 12) =TDELT* (GA (I) +SECTM ( I ) ) 

C IF (IPR.EQ.l) WRI TE (6,*) 1 , 1 S EC= ' , SECTM (I) , 1 GA= ' , G A ( I ) 

280 CONTINUE 
C 

DO 300 1=1,6 
VEC1 (l)=0.0 
300 CONTINUE 
C 

CALL MNU(19,6,ZZR) 

DO 180 1=1,6 

I F CABS (BETAA ( I ) ) .GT. (ZC3-1 .0) ) THEN 
DO 190 J=1 , 190 

zzz (1+13, J) =0.0 

190 CONTINUE 

ZZZ <1+1 3, 1+1 3) “1 .0 
VEC1 (1 + 13) =0.0 
END IF 
180 CONTINUE 
C 

I F (BETAA (7) .GT. (ZC1-1 .0) .OR, BETAA (7) .LT. (2.0*ZC0-ZC1+1 .0) ) THEN 
DO 191 1=1,19 
ZZZ (13, 1) =0.0 

191 CONTINUE 

ZZZ (13,1 3) =1 -0 
VEC1 (13) =0.0 
END IF 
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DO 370 1=1,6 
DO 370 J=1 ,6 

ZZR ( I , J) — EM2 (I ,J) 

370 CONTINUE 

C ZZR— D* 

I J0B=3 
I B0D=1 9 
DD 1 =1 .0 

C 

C 

CALL L I NRG ( I BOD.ZZZ, I BOD, ZZZ, I BOD) 

DO 978 1 = 1, 1 BOD 
VECC (I) =0.0 
DO 978 J=1 , 1 BOD 

VECC (I ) =ZZZ ( I , J) *VEC1 (J)+VECC(I) 

978 CONTINUE 

DO 972 1=1 , IBOD 
VEC 1 (I ) =VECC (I ) 

972 CONTINUE 
C 

C For cyber: 

C CALL LINV3F (ZZZ, VEC 1 , I JOB, IBOD, I BOD, OOl ,DD2, A I NV, I ER) 

C 

DETMNT=DD1* (2**DD2) 

C WRITE (6,*) 'The determinant of bodner matrix is: '.DETMNT 

C 

IF (IER.EQ.130) THEN 

WRITE (6,*) 'INVERSE PROBLEM IN BODNER MATRIX, STOP.' 

STOP 
END IF 
C 

CALL MMT(19,19,6,ZZZ,ZZR,T3D) 

C IF (I PR.EQ. 1) THEN 

C wr i te (6 , *) ' e 1 emen t= 1 , iaa 

C write (6, *) ' em2: ' 

C DO 940 1=1,6 

C WRITE (6,970) (EM2 (I ,J) ,J=1 ,6) 

C 940 CONTINUE 
C END IF 

C 

DO 3&0 1=1,6 
DO 360 J-1,6 

EM2 (I , J) =-T3D (I , J) 

EM4(IAA, IA, IB, 1C, l*6-6+J)=EM2(l ,J) 

360 CONTINUE 

C IF (I PR.EQ. 1) THEN 

C write (6,*) 'TDELT* 1 , tdel t 
C DO 980 1=1,6 

C WRITE (6,970) (EM2 (I ,J) ,J=1,6) 

C WRITE (6,970) (-T3D (I ,J) ,J=1,6) 

C 980 CONTINUE 
C END IF 

970 FORMAT (6F 12.1) 

C 

DO 380 1=1,6 

BOLD (I) — VEC1 (I) 

BDSVO AA, I A, I B, 1C, l)-BDLD(l) 

C I F (I PR.EQ. 1) WRITE (6,*) 'BDLD(I) : = ' , BOLD (I) 

380 CONTINUE 
C 

C EM2 and BDLD will be back to subroutine cb for assemble. 

C : • s ' ' 


DO 400 1=1,19 
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SVBLD (IAA, I A, IB, 1C, I)=VEC1 (1) 

400 CONTINUE 

C 

C WRITE (6,*) 'T3D IN BODNER 1 

00 420 1 = 1,19 
DO 422 J=1 ,6 

SVT30 (IAA, I A, IB, I C, I *6-6+J) =T3D ( I , J) 

422 CONTINUE 

C WRITE (6,423) (T3D (I ,K) ,K=1 ,6) 

420 CONTINUE 
C 

RETURN 

END 

C 

C END BODNER 

C 

C * ft ft ft ft ft ft * ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft ft it it it it* is ft ******** ft ft ft ft ft ft ft ft ft ft ft ft ft i< 
C Subroutine walsul is the solution phase using Walker's consti tutive 

C equation. 

C Input: 

C BL- used to find the local strain. 

C VFE- the displace i ncreament. epsl n=bl .vfe 

C SVT3D and SVBLD are the data calculated in the processing face. 

C State variable BETA (. . 12) are updated. 

C The derivative of the statevar iable STVDF and the derivative of the 
C nonl i near strain EPSND are calculated. 

C Vc & VoV fc i* & * ft ft >V ft & * ft ft iHe ^ 

C 

c 

SUBROUTINE WALSUL (IAA, IA, IB, 1C, BL, VFE, SVT3D, SVBLD, BETA, SD, 

1 BDSV, EM4, AA) 

C 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT I NTEGER*8 (I -N) 

DIMENSION BL (6,40) ,VFE (1) .SVT3D (NELM,2,2,2, 144) ,TMVEC(24) , 

1 SVBLD (NELM,2,2,2,24) .BETA (NELM,2,2,2, 12) ,SD(6, 1) , 

2 BDSV (NELM, 2 , 2,2,6) ,EM4 (NELM.2,2,2,36) , 

3 DBTA1 (6) , DBTA2 (6) , AA (6, 1) 

C 

COMMON /SCHALR1/ NELM, NNODE.NT 

COMMON /SCHALR2/ NEQT , NSTEP , NHBW , COE F 1 , COE F 2 , NSHOW 1 , NSH0W2 , 

1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 P3, ! P4, 1 P5, 1 P.6, I P7, 1 P8, 1 P9, 1 P10 
COMMON /PNTRRL/ IR1, IR2, IR3, IR4, IR5. IR6, IR7, IR8, IR9, IR10, 

1 IR1 1 , IR12, 1 R 1 3 » IR14, IR15, IRl6.IR17.IRl8, 

2 IR19, IR20, IR21.IR22, IR23, I R24, I R25, I R26, 

3 I R27 , I R28, I R29 , I R30 , I R3 1 , I R32 , IR33 , I R34 , 

4 IR35.IR36.IR37, I R38 , I R39 , IR40, I R4 1 , I R42 , 

5 IR43.1R44, I R45, I R46 , I R47 , I R48 , IR49.IR50 
COMMON /RLVEC/ VR(l) 

COMMON / 1 NTVEC/ I PT ( 1 ) 

COMMON /ITESCH/ ROOT.DTLAM.SGN, I PP.TROOT, ASO.SP 

COMMON /GEO/ TO 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ I NS I DT, KPDT, DTLM1 

COMMON /WAL/ WK,WB,WN2,WN3,WN4,WN5,WN6,WN8,WN9,WN10,WN1 1 ,WRO 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /UNIFBD/ IR51 , IR52, IR53, IR54, IR55, IR56, IR57, IR58, IR59 
COMMON /WKLMT/ WAL1.WAL2 
C 

I PR=0 

IF ((IA.EQ.1) .AND. (IB.EQ.l) .AND. (IC.EQ.l)) IPR»1 
C WRITE (6,*) ' IAA= '.IAA,' IA..IC MA.IB.IC 
C WRITE (6,*) 'WHERE CHANGED IN BODSUL' 

C DO 52 1=1,19 

C WRITE (6,53) (SVT3D (1 , 1,1,1, l*6-6+j) , J=1 ,6) 
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52 CONT i NUc. 

53 FORMAT (6F 12.4) 

59 FORMAT (sF12.lt) 

DO 6 0 1=1,24 
TMVEC ( I ) =0.0 
DO 80 J— 1 , 6 

TMVEC (l)=TMVEC (I) -SVT3D (IAA, I A , I B , I C , I *6-6+J) *AA (J, 1) 
80 CONTINUE 

TMVEC (l)=SVBLD(IAA, I A, IB, 1C, l)+TMVEC(l) 

IF (IPR.EQ.l) THEN 

WRITE (6,*) I,' TMVEC (I) IN SOLFACE: ' , TMVEC (I) 

END IF 
•0 CONTINUE 

DO 100 1=1,6 

SD (I , 1) =TMVEC (I) 

DBTA1 (l)=TMVEC (1 + 12) 

DBTA2(I)=TMVEC(I + 18) 

WRITE (6,*) I,' D (Zd/DT) : 1 ,STVDF (I AA, I A, I B, I C, I) 

100 CONTINUE 


DO 120 1=1,6 

BETA (I AA, I A, IB, 1C, l)=BETA(l AA, I A, IB, I C, D+DBTAl (I) 

BETA ( I AA, I A, IB, 1C, 1+6) -BETA (I AA, I A, IB, 1C, 1+6) +DBTA2 ( I ) 

I F (BETA (I AA, I A, IB, 1C, I) .GT.WAL1) BETA (I AA, I A, IB, 1C, I)=WAL1 
IF (BETA (I AA, I A, IB, 1C, 1) .LT.-WAL1) BETA ( I AA, I A, I B, I C, I ) =-WAl 1 
IF (BETA (I AA, I A, IB, 1C, 1+6) .GT.WAL2) BETA ( I AA, I A, I B, I C, l+6)=WAL2 
IF (BETA (I AA, I A, IB, 1C, 1+6) .LT.-WAL1) BETA (I AA, I A, IB, 1C, l+6)=-WAL2 
C if (ipr.eq.l) then 

C write(6,*) i, 1 dtal = ‘ ,dbtal (i) , ' dbta2=‘ ,dbta2 (i) 

C WRITE (6,*) I,' BA1 : 1 , BETA (I AA, I A , I B, I C, I ) , 

C 1 1 ba2=' .beta (i aa , i a, i b, i c, i+6) 

C end i f 

120 CONTINUE 
C 

RETURN 

END 

C END (WALSOL) 

C 

C * * * ft ft* ft ft* * * ft ft ft * ft* ft ft * ft * ft )'« *** ft ft ft ft ft ft* * ****** ******* ft* ******** **** ****** ft 


C * Subroutine WALKER is to prepare the stiffness matrix and the * 
C * residure force. Input is the state variable and current stress. * 
C * Output is EM2 (to form stiffness matrix by cb) , BDLD * 
C * (to form the force term by cb) , SVT3D and SVBLD (will be used * 
C * in the sulution face) * 


C ft ft * *** ft * ft* ft *** * * ******** ft ft** ft ft* *. * ft* ft* ft ** *************************** ft ft 

c 

SUBROUTINE WALKER (I I I , I AA, I A, I B, I C, S I G.ZZZ, EM2 ,S , BETA, BDLD, 

1 SVT3D, SVBLD, ZZR, BDSV, EM4 , A I NV) 

C 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGERS (I -N) 

DIMENSION SI G (3,3) ,ZZZ (2k, 2k) ,EM2(6,6) ,S (3,3) .BETA (NELM,2,2,2, 12) , 

1 BDLD (1) ,SVT3D (NELM,2,2,2, 144) .SVBLD (NELM,2,2,2,24) , 

2 ZZR(24,6) , VEC1 (24) ,VCTL(24) ,GA(24) , BETAA (6) ,AINV(1) , 

3 VEPS (6) , SS (6) ,SECTM (12) ,T3D(24,6) ,VEPSLN(3,3) . 

4 BDSV(NELM,2,2,2,6) ,EM4 (NELM, 2,2,2, 3&) ,SIGVC(6) 

5 , AAA (6,6) , BBB (6,6) ,CCC(6,6) ,DDD(6,6) , BTA1 (6) ,BTA2(6) 

6 ,DEFW (6) ,SGNW(6) ,VECC (24) 

C 

COMMON /WAL/ WK,WB,WN2,WN3,WN4,WN5,WN6,WN8,WN9,WN10,WN1 1 ,WR0 
COMMON /UNICT/ NCONS .MODEL , ETAA,TDELT,TI N I T 
COMMON /UNIFBD/ IR51 , IR52, IR53, IR54, IR55, I R56, IR57, IR58, IR59 
COMMON /SCHALR1/ NELM.NNODE ,NT 

COMMON /SCHALR2/ NEQT.NSTEP.NHBW, COEF 1 , C0EF2, NSH0W1 .NSH0W2, 
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1 NSH0W3.HRZ, I TRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 P3, 1 P4, 1 P5, IP6, IP7, IP8, IP9, 1 PIO 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, IR7, IR8, IR9, IRIO, 

1 IR11, IR12, IR13, IR14, 1 R 1 5 , IR16, IR17. 1 R18, 

2 IR19, IR20, IR21 , IR22, IR23, 1R24, IR25, IR26, 

3 IR27.IR28, IR29, IR30,IR31,IR32, IR33.IR34, 

4 IR35, IR36, IR37, IR38, IR39, IR^O, IR41, IR42, 

5 IR43, IR44, I Ri»5 » ( IR47, IR48, IR49, 1R50 
COMMON /RLVEC/ VR ( 1 ) 

COMMON / I NTVEC/ 1 PT ( 1 ) 

COMMON /ITESCH/ ROOT.DTLAM.SGN, IPP,TROOT,ASO,SP 

COMMON /GEO/ TO 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ I NS I DT , KPDT , DTLM 1 

COMMON /ABDFST/ I SEC 

COMMON /WKLMT/ WAL1.WAL2 

COMMON /NCTT/ NCT (12,2,2,2) 

C ZNO.DO are input constants in k i nemati cal equation. 

ACS.ZCl ,ZC2,ZC3,CM1 ,CM2 are constants in state variable equations. 
CR1.CR2 AS WELL. 

S(i,j) is the stress deviator 
DJ2=1/2*S (I , J) *S (I , J) 

SJ2=SIG (I , J) *S I G (I , J) 

ZVl=Zi 

SIGM (6) S IG (3,3) .... 

VSTV=D (Z) /DT 
VSTV1=D (ZV1) /DT 

ET=-ETA*TDELT where eta and del tat are given. 

I PRO 

IF ((IA.EQ.1) .AND. (IB.EQ.l) .AND. (IC.EQ.l)) IPR=1 
DO 20 1*1,6 

BTA1 ( I ) “BETA (I AA, I A, IB, 1C, I) 

BTA2 (I ) =BETA ( I AA, IA, IB, 1C, 1+6) 

20 CONTINUE 

DO 30 1=1,6 

BETAA (I)=BTA1 (t)+BTA2 (I ) 

30 CONTINUE 

ET=-ETAA*TDELT 

SAV= (SIG (1 , 1 ) +S I G (2 , 2) +S I G (3 , 3) ) /3 • 0 
C 

DO 90 1=1,3 
DO 90 J=1 ,3 

IF(I.EQ.J) THEN 
S(l ,J) =S I G (I , J) -SAV 
ELSE 

5(1 ,J)*SIG(I ,J) 

END IF 
90 CONTINUE 

C 

SS(1)=S(1,1) 

$S(2) =S (2,2) 

SS (3) 0 (3,3) 

SS (4) =S (1 ,2) 

SS (5) =S (2,3) 

SS (6)*S (1,3) 

C 

c 

DO 60 1*1,6 

DEFW (I) *1 -5*SS ( I ) -BETAA (!) 
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IF (DEFW(I) .GE .0.0) THEN 
SGNW (I) =1 .0 
ELSE 

SGNW ( I ) =- 1 .0 
END IF 

if (ipr.eq.l) then 

write (6,*) i,' fatal-' ,btal (i) , 1 fata'2- 1 ,bta2 (i ) , ' def=',defw( 
end i f 
60 CONTINUE 

WJ2=0 .0 
SJ 2=0.0 

DO 80 1=1,6 

I F ( I . LE . 3) THEN 
WJ2=WJ2+DEFW ( I ) *DEFW ( I ) 

ELSE 

WJ2-WJ2+2.0*DEFW(I) *DEFW(I) 

END IF 
80 CONTINUE 

C0W1- (2. 0/3,0) **0.5 

WJSQ=WJ2**0.5 

RTW-C0W1 *WJSQ 

WJSE= (EXP (RTW/WK) - 1 .0) /WB 

wr i te (6 , *) 1 i i i i n wa i k 1 , i i i 
ISEE=NCT(I AA, I A, IB, 1C) 

DO 40 1=1,6 

VEPS ( I ) =DEFW ( I ) *WJSE/RTW 
EPSND (IAA, I A, IB, 1C, l)=VEPS (l) 

40 CONTINUE 

NCT (IAA, I A, IB, IC)=1 

if ( ( i a.eq . 1) .and . ( i b .eq . 1) .and . (ic.eq . 1) ) then 
write (6,*) (veps (i) , i = l ,6) 
end i f 

FACl=3.0*ET*WJSE/RTW/2.0 

F AC2= (EXP (RTW/WK) /WB/WK/RTW/RTW-WJSE/RTW**3) *ET 
BTTN= (BETAA ( 1 ) +BETAA (2) +BETAA (3) ) /3 .0 

if (ipr.eq.l) then 

write (6,*) 1 s i g=' , s ig (2 , 2) , 1 defw=‘ ,defw(2) 
write (6,*) 1 rtw-' , rtw, ' wjse- 1 ,wjse, 1 j 2= 1 ,wj2 
write(6,*) 1 facl=' ,facl , ' fac2=',fac2 
wr i te (6 , *) 'defw(l) = ' ,defw(l) , ' st=*,bttn 
end i f 

Now -eta*deltat is included in the formula in first 6*6 matrix 
CALL MNU(24,24,ZZZ) 


BTTN=Q.O 

ZZZ (7 , 1 ) =F AC 1 *2 . 0/3 . 0+F AC2*D E F W ( 1) * (D E F W ( 1) +BTTN) 
ZZZ (7 , 2) =-FACl/3.0+FAC2*DEFW (1) * (DEFW (2)+BTTN) 

ZZZ (7,3)=-FACl/3.0+FAC2*DEFW(l)*(DEFW(3)+BTTN) 

ZZZ (7 , 4) =FAC2*DEFW (1) *DEFW (4) 

ZZZ (7,5) =FAC2*DEFW (1) *DEFW (5) 

ZZZ (7 , 6) =FAC2*DEFW ( 1 ) *DEFW (6) 

ZZZ (8, 1) =-FAC1/3.0+FAC2*DEFW(2) * (DEFW (1) +BTTN) 

ZZZ (8,2) =FACl*2.0/3.0+FAC2*DEFW(2) * (DEFW (2) +BTTN) 
ZZZ (8 , 3) =-F AC 1 /3 • 0+F AC2*DEFW (2) * (DE FW (3) +BTTN) 

ZZZ (8,4) =FAC2*DEFW (2) *DEFW (4) 

ZZZ (8,5) =FAC2*DEFW(2) *DEFW (5) 

ZZZ (8,6) =FAC2*DEFW (2) *DEFW (6) 
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ZZZ (9,1) “-FAC1/3. 0+FAC2*DEFW(3)* (DEFW ( 1 ) +BTTN) 

ZZZ (9 , 2) =- F AC 1 /3 . 0+F AC2*DE F W (3) * (OEFW (2) +BTTN) 

ZZZ 19,3) =FACl*2.0/3.0+FAC2*DEFW (3) * (DEFW (3)+BTTN) 
ZZZ(9 ,m)=FAC2*DEFW(3) *DEFW(A) 

ZZZ (9 . 5 ) =FAC2*DEFW(3) *DEFW(5) 

ZZZ (9,6) *=FAC2*DEFW(3) *DEFW (6) 

ZZZ (10, 1)=FAC2*DEFW (A) * (DEFW (1) +BTTN) 

ZZZ 00,2) =F AC2*DEFW (A) * (DEFW (2) +BTTN) 

ZZZ (1 0 , 3) -F AC2*DEFW (A) * (DEFW (3) +BTTN) 

ZZZ (10, A) =FAC2*DEFW (A) *DEFW (A)+F AC 1 
ZZZ ( 1 0,5) =FAC2*DEFW (A) *DEFW (5) 

ZZZ (10, 6) =FAC2*DEFW (A)*DEFW(6) 

ZZZ (1 1 , 1)=FAC2*DEFW(5) * (DEFW (1)+BTTN) 

ZZZ (11 ,2) =FAC2*DEFW(5) * (DEFW (2)+BTTN) 

ZZZ (1 1 , 3) =FAC2*DEFW (5) * (DEFW (3) +BTTN) 

ZZZ ( H , A) =FAC2*DEFW (5) *DEFW (A) 

ZZZ (11,5) =FAC2*DEFW (5) *DEFW(5)+FAC1 
ZZZ (1 1 ,6) =FAC2*DEPW (5) *DEFW (6) 

ZZZ (12, 1) =F AC2*DEFW (6) * (DEFW (1)+BTTN) 

ZZZ ( 1 2 , 2) =F AC2*DEFW (6) * (DEFW (2) +BTTN) 

ZZZ ( 1 2 , 3) -F AC2*DE FW (6) * (DEFW (3) +BTTN) 

ZZZ ( 1 2 , A) =FAC2*DEFW (6) *DEFW (A) 

ZZZ (12 , 5) “F AC2*DE FW (6) *DEFW (5) 

ZZZ (12,6) -FAC2*DEFW (6)*DEFW (6) +FAC1 


ZZZ (7, 7) -1.0 
ZZZ (8,8) *1 .0 
ZZZ (9,9) «1 .0 
ZZZ (10, ID)'- 1.0 
ZZZ (IT, 11) -1.0 
ZZZ (12, 12) -1.0 

FAC3—FAC1/3. 0*2.0 
FACA—FAC2*2. 0/3.0 

ZZZ (7 , 1 3) =FACA*DEFW (1 ) *DEFW (1 )+FAC3 
ZZZ ( 8 , 13 ) “FACA*DEFW (2) *DEFW (1) 

ZZZ (9, 13)=FACA*DEFW(3) *DEFW(1) 

ZZZ ( 1 0 , 1 3) -F AC A*DE FW (A) *DE FW ( 1 ) 

ZZZ (11, 13) =FACA*DEFW(5)*DEFW(1) 

ZZZ (12,13)=FACA*DEFW(6) *DEFW(1) 

ZZZ (7 , 1 A) =F AC A*D E F W ( 1 ) *DE F W (2) 

ZZZ (8,1A)-FACA*DEFW(2)*DEFW(2)+FAC3 
ZZZ (9, 1A) =FACA*DEFW (3) *DEFW(2) 

ZZZ (10, 1 A) -FACA*DEFW (A) *DEFW(2) 

ZZZ (11 , 1 A) =FACA*DEFW (5) *DEFW (2) 

ZZZ ( 1 2 , 1 A) »F ACAADEFW (6) *DEFW (2) 

ZZZ (7,15)=FACA*DEFW(1)*DEFW(3) 

ZZZ (8 ,15) -FACA*DEFW (2) *DEFW (3) 

ZZZ (9,15) -F ACA*DE FW (3) *DE FW (3) +FAC3 
ZZZ (10, 15) =FACA*DEFW(A)*0EFW(3) 

ZZZ (1 1 , 15) »FACA*DEFW (5) *DEFW (3) 

ZZZ (12, 15) =FACA*DEFW (6) *DEFW (3) 

ZZZ (7,16) =F ACA*DE FW ( 1 ) *DEFW (A) 

ZZZ (9* l6) =FACA*DEFW (3) *DEFW (A) 

ZZZ (10, 16 ) -FACAADEFW (A) *DEFW (A) +FAC3 
ZZZ (1 1 , 16) -FACA*DEFW(5) *DEFW(A) 

ZZZ (1 2 , 16) =F ACA*DEFW (6) *DEFW (A) 
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ZZZ (7.17) =FAC4*DEFW (1) *DEFW (5) 

ZZZ (8,17) =FAC4*DEFW (2) *DEFW (5) 

111 (9,17) =FAC4*DEFW (3) *DEFW (5) 
ZZZ(10,17)=FAC4*DEFW(4)*DEFW (5) 

111 (11,17) =FAC4*DEFW (5) *DEFW (5) +FAC3 
ZZZ (12,17) =FAC4*DEFW (6) *DEFW (5) 

ZZZ(7,l8)=FAC4*DEFW(l)*DEFW(6) 

ZZZ (8, 18) =FAC4*DEFW (2) *DIFW (6) 

111 (9,18) =F AC4*DEFW (3) *DEFW (6) 

ZZZ (10, l8)=FAC4*DEFW(4)*DEFW(6) 

ZZZ (1 1 , 18) =FAC4*DEFW (5) *DEFW (6) 

ZZZ (1 2 , 1 8) =F AC4*DEFW (6) *DEFW (6) +F AC4 

DO 120 1=7.12 
DO 120 J=1 ,6 

ZZZ(1 , J+18) =ZZZ(I , J+l 2) 

120 CONTINUE 


Next part is -[G.epslon n] 

PWR=0 .0 
DO 145 1=1,6 
IF (I . LE . 3) THEN 
PWR=PWR+VE PS ( I ) *VEPS ( I ) 

ELSE 

PWR=PWR+2 . 0*VE PS ( I ) *VEPS ( I ) 

END IF 
145 CONTINUE 

PWR= (2 . 0*PWR/3 . 0) **0 . 5 

WRITE (6,*) 'PLASTIC WORK IS: ’ ,PWR 

IF (PWR.GT.WRO) THEN 
FAC5= (WRO/PWR) **WN5 

FAC7=-2.0*WN5* (WR0**WN5) * (PWR** (-WN5-1 .0) ) *WN4/3-0 
ELSE 

FAC5= (PWR/WRO) **WN5 

FAC7=2.0* (PWR** (WN5- 1.0))/ (WR0**WN5) /3.0*WN4 
END IF 

FAC6=2.0*(WN3+WN4*FAC5)/3.0/PWR+FAC7 

WRITE (6,*) 1 FAC6; ',FAC6 

FAC8=2.0*WN9/3-0/PWR 
DO 150 1=1,6 
DO 150 J-1,6 
IF(I.EQ.J) THEN 

ZZZ (12+1 , 6+J) =F AC6*BT A 1 (l)*VEPS (J) -WN2 
ZZZ (18+1 ,6+J) =FAC8*BTA2 (I) *VEPS(J) -WN1 1 
ELSE 

ZZZ (1 2+ 1 , 6+J) =FAC6*BTA 1(1) *VEPS (J) 

ZZZ (18+1 ,6+J) =FAC8*BTA2 (I) *VEPS (J) 

END IF 

150 CONTINUE 

Next part: dg/dx 

FAC9=- ( (WN4*F AC5+WN3) *PWR+WN6) *ET 
FAC10=- (WN9*PWR+WN10) *ET 

DO 1 60 1=1,6 
DO 160 J=1 ,6 
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IF (I .EQ.J) THEN 
ZZZ (12+1 , 12+J)=1 .0+FAC9 
ZZZ(l8+l,l8+J)=1.0+FAC10 
ZZZ (I ,J)=1.0 
END IF 

1 60 CONTINUE 

C 

DO 333 1=1,6 
DO 333 J=1,6 

ZZZ ( I , J+6) =EM2 (I , J) 

333 CONTINUE 
C 

C Now matrix [zzz] is formed. 

C Next step is to find the vector part. 

C 

S I GVC (1) =S I G (1 , 1) 

S I GVC (2) =S I G (2 , 2) 

S I GVC (3) =SIG (3,3) 

S I GVC (4)=SIG (1 ,2) 

S I GVC (5) =SIG (2,3) 

S I GVC (6) =S I G (1 ,3) 

C 

C VCTL0..6) is the difference of d(epslon)/dt and f. 
C 

, DO 200 1=1,6 

VEC1 (l+6)=TDELT*VEPS (I) 

200 CONTINUE 
C 

C SECTM(i) is (G,epslon*d (epslon) /dt) 

C 

DO 220 1=1,12 
SECTM (I ) =0.0 
DO 220 J=1 ,6 

ZZZ (1+12, J+6) =0.0 
220 CONTINUE 
C 

C GA is the state variable g 
C 

FAC 1 2=PWR* (WN3+WN4*F AC5) +WN6 
FACT 3=WN9*PWR+WN 1 0 
DO 240 1=1,6 

GA ( I ) =WN2*VEPS ( I ) “BTA 1 ( I ) *F AC 1 2 
GA(I+6)=WN11*VEPS(I)-BTA2(I)*FAC13 
C WRITE(6,*) 'GA 2..7=Zd: 1 , GA (1 + 1) 

240 CONTINUE 
C 
C 

DO 280 1=1,12 

VEC1 (l + 12)=TDELT*GA (I) 

280 CONTINUE 
C 

DO 300 1=1,6 
VEC1 (I) =0.0 

I F (ABS (BTA1 (I)) .GT. (WAL1-1.0)) VEC1 (1 + 12) =0.0 
300 CONTINUE 
C 

CALL MNU (24,6,ZZR) 

C 

DO 370 1=1,6 
DO 370 J=1 ,6 

ZZR (I ,J)=-EM2(I,J) 

370 CONTINUE 
C 

C ZZR=-D* 

C 

I J0B=3 
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1800=24 
DO » = 1 .0 
DO 3^0 1 = 1,24 

Wft i TE (6 , *) ' I = ' , I , ' VEC1 (I) : ' , VEC 1 ( I ) 

C-,10 CONTINUE 

00 320 1=1,19 

WRITE (6,330) (ZZZ ( I ,J) ,J=1,12) 

E320 CONTINUE 
C DO 340 1=1,19 

C WRITE (6,350) (ZZZ (I , J) , J=1 3* 19) 

’340 CONTINUE 
330 FORMAT (12F6.1) 

350 FORMAT (7F9- 2) 

C For cyber: 

C CALL L I NV3F (ZZZ, VEC 1 , I JOB, I BOD , I BOD, DO 1 , DD2, A I NV, I ER) 

CALL L I NRG (I BOD, ZZZ, I BOD, ZZZ, I BOD) 

DO 978 1=1, I BOD 
VECC ( I ) =0.0 
DO 978 J=1 , I BOD 

VECC ( I ) =ZZZ { I , J) *VEC 1 (J) +VECC ( I ) 

978 CONTINUE 

DO 972 1=1 , I BOD 
VEC1 (I) =VECC (I) 

972 CONTINUE 
C 

DETMNT=DD1*(2**DD2) 

WRITE (6,*) 'The determinant of bodner matrix is: '.DETMNT 
IF (IER.EQ.130) THEN 

WRITE (6,*) 'INVERSE PROBLEM IN BODNER MATRIX, STOP.' 
STOP 
END IF 

CALL MMT(24,24,6,ZZZ,ZZR,T3D) 

I F (I PR.EQ. 1) THEN 
DO 940 1=1,6 

WRITE (6,970) (EM2 (I , J) , J=1 ,6) 

940 CONTINUE 

END IF \ 

DO 360 1=1,6 
DO 360 J=1 ,6 

EM2 ( I ,J) =-T3D(I ,J) 

EM4 ( I AA , I A , I B , I C , I *6-6+J) =EM2 ( I , J) 

360 CONTINUE 

I F (I PR.EQ. 1) THEN 
DO 980 1=1,6 

WRITE (6,970) (EM2 (I , J) , J=1 ,6) 

WR I TE ( 6 , 970) (-T3D ( 1 , J) , J= 1 , 6) 

980 CONTINUE 
END IF 

970 FORMAT (6F 12.1) 

DO 380 1=1,6 

BOLD ( I ) =-VEC 1 (I) 

BDSV(IAA, IA, IB, 1C, I)=VEC1 (I) 

WRITE(6,*) 'BDLD(I) :=-ZITA ' , BDLD ( I ) 

380 CONTINUE 

EM2 and BDLD will be back to subroutine cb for assemble. 

DO 400 1=1,24 

SVBLD (IAA,IA,IB,IC,I) =VEC1 (I) 

400 CONTINUE 
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WRITE (6,*) ' J3D IN BODNER' 

DO 420 1=1,24 
DO 422 J=1 ,6 

SVT3D (I AA, IA, IB, 1C, l*6-6+J)=T3D(l ,J) 

422 CONTINUE 
420 CONTINUE 

SVT3B and SVBLD will be used in processing face. 

RETURN 

END 

(END WALKER) 


Subroutine is used to calculate the material constants of 
Bodner-Partom type of constitutive equations. The material 
used is B 1 900+Hf . For different material, this subroutine 
should be modified. 

SUBROUTINE BDCNS (TMPP) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

COMMON /BOD/ D0,ZC0,ZC1 ,ZC2,ZC3,ZM1 .ZM2.CA1 ,CA2,CR1 .CR2.ZN0 
COMMON /MTL/ E,EU 

E= 1 98700.0+16 . 78*TMPP-0 . 1034*TMPP*TMPP 
1 +0.00001 143*TMPP*TMPP*TMPP 

WRITE (6,*) 'BODNER CONST: E=',E 
EU=0. 3 
D0= 10000.0 
ZC0=2700.0 
ZC1=3000.0 
ZC2=2700.0 
ZC3=i 150.0 
ZM1=0.27 
ZM2=1 .52 
CA 1=0.0 
CA2=0 .0 
CR 1=2.0 
CR2=2 .0 
ZN0=1 .055 

IF (TMPP. LT. 760.0) THEN 
ZC0=2700.0 
CA1=0 .0 
ZN0=1 .055 
END IF 

IF ((TMPP. GE. 760.0) .AND. (TMPP.LT.87i .0)) THEN 
ZCO=2700.0- (TMPP-760.0)/l 11 .0*300.0 
CA1= (TMPP-7&0.0) /1 1 1 .0*0.0055 
ZN0=1 .055- (TMPP-760.0) /1 1 1 .0*0.025 
END IF 

IF ((TMPP. GE. 871.0) .AND. (TMPP. LT. 982. 0) ) THEN 
ZC0=2400.0- (TMPP-87 1 .0 ) /l 1 1 . 0*500.0 
C A 1 = (TMPP-87 1 • 0) / 1 1 1 . 0*0 . 0 1 45+0 . 0055 
ZN0=1 .03- (TMPP-871 .0) /1 1 1 .0*0.18 
END IF 

IF ((TMPP. GE. 982.0) .AND. (TMPP. LT. 1093-0) ) THEN 

zco= 1900.0- (TMPP-982.0) /1 1 1 .0*700.0 
CA 1 = (TMPP-982 . 0) / 1 1 1 . 0*0 . 23+0 . 02 
ZNO=0 . 85- (TMPP-982 . 0) /I 1 1 .0*0 . 1 5 
END IF 
CA2=CA1 
ZC2=ZC0 
C 

C WRITE (6,*) 'ELASTIC MODULUS*' ,E 

66 



WRITE (6,*) 'ELASTIC MODULUS® 1 ,E, 1 ZO=» ,ZCO, ' A® 1 , CA 1 , 1 N®',ZNO 

RETURN 

END 


C Subroutine is used to calculate the material constants of 
C Walker type of constitutive equations. The material 
C used is B1900+Hf. For different material, this subroutine 
C should be modified. 

C 

SUBROUTINE WKCNS (TMPP) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGERS (l-N) 

COMMON /WAL/ WK,WB,WN2,WN3> WN4 , WN5» WN6 , WN8.WN9 , WN 1 0 , WN 1 1 , WRO 
COMMON /MTL/ E,EU 
COMMON /WKLMT/ WAL1.WAL2 
C 
C 

TEM=TMPP 
WK=12.4 
WB=1 . 73E 1 1 
WN2=2 .41 E6 
WN3=479 i *-0 
WN 4=0.0 
WN5=0.31 17 
WN 6=0.0 
WN7=0.0 
WN8=0.0 
WN9=1 1 .87 
WN 10=0.0 
WN1 1=4.7E3 
WR0=1 .0E-4 
E=1.9E5 

IF ( (TEM.GT.-0.01) .AND. (TEM.LT. 427-0) ) THEN 
STEfTEM/427 .0 
EU=0 . 322+ (0 . 328-0 . 322) *STE 
END IF 

IF ((TEM.GE. 427-0) .AND. (TEM.LT. 538.0) ) THEN 
STE= (TEM-427 . 0) / (538.0-427.0) 

EU=0 . 328+ (0.331-0. 328) *STE 
END IF 

IF ((TEM.GE. 538.0) .AND. (TEM.LT. 649.0) ) THEN 
STE= (TEM-538.0) / (649.0-538.0) 

E=1 .9E5+(1 .8E5-1.9E5) *STE 
EU=0 . 33 1+ (0 . 33^-0 . 331 ) *STE 
WB=1 . 73E1 1+ (3.862E 10-1 .73E 1 1) *STE 
WN2=2 . 4 1 E6+ (8 . 27E5-2 . 4 1 E6) *STE 
WN3=479 1 * . 0+ ( 1 7 1 4.0-4794.0) *STE 
WN9=1 1 .87+ (16.64-1 1 .87) *STE 
END IF 
C 

IF ((TEM.GE. 649.0) .AND. (TEM.LT. 760.0) ) THEN 
STE= (TEM-649 . 0) / (760 .0-649 .0) 

E=1 .8E5+(1 .655E5-1 .8E5) *STE 

EU=0 . 334+ (0 . 339-0 . 33 1 *) *STE 

WK= 1 2 . 4+ ( 1 3 • 8 - 1 2 . 4) *STE 

WB=3 . 862 E 10+ (2 . 55E 10-3 .862E 10 ) *STE 

WN2=8.27E5 

WN3= 1 7 1 4 . 0+ ( 1 880 . 0- 1 7 1 4 .0) *STE 
WN4=-585.0*STE 
WN 9 = 16. 64+ ( 19 . 83 - 16.64) *STE 
WN 1 0=2 . 44E~3*STE 
END IF 
C 

IF ((TEM.GE. 760.0) .AND. (TEM.LT. 871 .0) ) THEN 
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STE= (TEM- 76 O.O) / ( 871 . 0 - 760 . 0 ) 

E=1 .655E5+0 .438E5-1 .655E5) *STE 

EU=o . 339 + ( 0 . 324 - 0 . 339 ) *STE 

WK= 1 3 • 8 + ( 1 6 . 6 - 1 3 > 8 ) *STE 

WB=2 . 55E 1 0+ (5 . 5E 1 2-2 .55E 10) *STE 

WN2=8 . 27E5+ (2 . 36E5-8 ,27E5) *STE 

WN 3= 1 880 . 0+ (62 1 . 2- 1 880 . 0) *STE 

WN4=~585 .O+ 585 .0*StE 

WN6=8.73E-4*STE 

WN9= 1 9 • 83 + (59 • 33 - 1 9 . 83 ) *STE 

WN10=2.44E-3 

WN 11=4 . 70E3+ (9 • 65E2-4 . 7E3) *STE 
END IF 

IF ((TEM.GE. 871.0) .AND. (TEM.LT. 982 .O) ) THEN 
STE= (TEN-871.0) / (982 .0-871 .0) 

E=1 .438E5+(1 -249E5-1 -438E5) *STE 
EU=0. 324+ (0.351-0. 324) *STE 
WK=16.6+ (13.8-16.6) *STE 
WB»5 . 5E 1 2+ (4 . 2E 1 0-5 . 5E 1 2) *STE 
WN2»2 . 36E5+ (9 • 65E4-2 . 36E5) *STE 
WN3=62 1 . 2+ (400.0-62 1 . 2) *STE 
WN4=0 .0 

WN6=8 . 73E-4+ (4 . 29E-4-8 . 73E-4) *STE 
WN9=59 • 33+ (1 36.0-59 • 33) *STE 
WN10=2.44E-3 

WN1 1=9.65E2+ (-9.65E2) *STE 
END IF 

IF ((TEM.GE. 982.0) .AND. (TEM.LE. 1093.0)) THEN 
STE=(TEM-982.0)/ (1093.0-982.0) 
E=1.249E5+(1 .161E5-1.249E5)*STE 
EU=0.351 

WK*13. 8 + (9.0-13.8) *STE 
WB=4 . 2E 1 0+ (5 -57E9-4 . 2E 10) *STE 
WN2=9 . 65E4+ (2 . 36E4-9 . 65E4) *STE 
WN 3=400.0+ (278 .7-400.0) *STE 
WN 4=0.0 

WN6=4 . 29E-4+ (4 . 83E-2-4 . 29E-4) *STE 
WN9= 136.0 
WN10=2.44E-3 
WN1 1=0.0 
END IF 


IF (TEM.GT. 1093.0) THEN 

WRITE (6,*) 'MATERIAL CONSTANTS ARE NOT AVAILABLE' 
STOP 
END IF 

WAL1=WN2/WN3 

WAL2«WN11/WN9 


WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6.*) 
WRITE (6,*) 


' WK=' , WK 
' WB= ' , WB 
1 WN2= ' ,WN2 
'WN3=' ,WN3 
' WN4=' ,WN4 
'WN5=',WN5 
'WN6=' ,WN6 
•WN8=',WN8 
'WN9=' .WN9 
' WN 1 0= ' , WN 1 0 
'WN1 1= 4 , WN1 1 
' WRO= 1 ,WR0 
' WLMT1=' , WAL 1 
' WLMT2=' ,WAL2 
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RETURN 

END 


C Subroutine THRML is for the calculationof thermal effects 

C of the structure. Newton-Raphson 1 s iteration scheme is used 

C in the equilibrium iterations. 

C 

SUBROUTINE THRML ( I NUM, I EL , I D , I i D , L ,MAXA, LD.XX, YY ,ZZ, DLOADT, 

1 D, PLD, FRCO, DD , DLD I NC, VTEMP, VF , D 1 , VFE , DDD , 

2 AM, PD , P , A ,TDLD , H I S I NC , ACMD IS , FRC I NC , XX 1 , YY 1 , 

ZZ1 , DELTA,UPSIG,SIGMA,DLTINC,DLTTMP,STI FFN, 

EXLVC, BETA , UPBET , ACTFRC , GCL 1 , GCL2 , GCL3.UCL 1 , 
UCL2.UCL3.DD1) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8 (l-N) 

DIMENSION I EL (NELM, 5) , I D (1) , I ID (NNODE, 5) , L ( 1 ) , MAX A ( 1 ) 

DIMENSION XX (1) ,YY(1) , ZZ (1) , DD (NNODE ,5) ,D(1) ,PLD(1) , 

DLOADT (1) , DLD I NC (1) , VTEMP (1) ,VF (NNODE, 5) . 

D1 (NNODE, 5) , VFE (NT, 1) v DDD (1) ,P(1) ,VRT(4) , 

A (NEQT.NEQT) ,AM(40,40) , PD (1) ,TDLD (1) , 

HISINC(l) , ACMD I S (1) , FRC I NC (1) ,XX1 (1) ,YY1 (1) ,ZZ1 (1) , 
DELTA (1) , FRCO (1) ,UPSIG (NELM, 2, 2, 2, 9) , ACTFRC (1) , 

SIGMA (NELM, 2, 2, 2, 9 ) .DLTINC (1) , DLTTMP (1) , COE E Q (5) , 

DEFVRT (4) , ST I FFN (NT, NT) ,ETT(4) .EXLVC (1) ,DD1 (1) , 

BETA (NELM, 2, 2, 2, 12) , UPBET (NELM, 2, 2 ,2,12), GCL 1 (NNODE , 3) , 
GCL2 (NNODE, 3) , GCL3 (NNODE , 3) ,UCL1 (NNODE, 3) . 

UCL2 (NNODE , 3) , UCL3 (NNODE, 3) 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT,NSTEP,NHBW,C0EF1, CO EF2,NSH0W1,NSH0W2, 
NSHOW3.HRZ, 1 TRIM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, I P3, I P4, I P5, I P6, I P7, I P8, IP9» I P10 
COMMON /PNTRRL/ I R 1 , I R2 , I R3 , I R4 , I R5 , I R6 , I R7 , I R8 , I R9 , 1 R 1 0 , 

IR1 1 , IR12, 1 R 1 3 , IRH, IR15, IRl6.IR17.iRl8, 

IR19, 1R20, IR21, IR22, IR23, IR24, IR25, IR26, 

IR27, IR28, IR29, IR30, 1R31 , IR32, IR33. IR3<»> 

IR35, IR36, IR37, IR38, IR39, IR40, IR41 , IR42, 

IR43, IR44, IRi*5, IR46, IR47, IR48, IR49, IR50 
COMMON /UNIFBD/ JR51, IR52, IR53, IR54, IR55, IR56, IR57, IR58, IR59 
COMMON /DIRCS/ IR60, IR6l , IR62, IR63, IR64, IR 65 
COMMON /D I SVC/ I R66 , 1 R67 , 1 R68 , 1 
COMMON /DISV1/ IR70,IR71,IR72,IR73,IR74,IR75 
COMMON /UNICT/ NCONS,MODEL,ETAA,TDELT,TI NIT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT.DTLAM.SGN, I PP.TROOT, ASO.SP 

COMMON /GEO/ TO 

COMMON /CNTRL/ DETMNT 

COMMON /CONTN/ I NS I DT, KPDT, DTLM1 

COMMON /ABDFST/ I SEC 

COMMON /MTL/ E,EU 

COMMON /NMBITR/ NUM 

COMMON /CNTR/ I CNTR 

COMMON /TMPCQ/ ICTMP 

COMMON /TMPEF/ I DO , NTEM, N I TR , NANM, CEXPN ,TMM I N ,TM I NC , TMMAX , TMPP 

C 

C 

I CTMP=1 

C (The switch to the effects of the change of temperature is on) 

ND=NEQT 

I CNTR= I CNTR+1 . 

Initiate some variables. 

CALL INIT (VR (IR1) ,VR(IR2) ,VR(IR3) ,VR(IR43) ,VR(IR44) ,VR(IR45) , 


C 

C 

c 
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5 VR(IR 60 ) ,VR (I R6l) ,VR(IR62) » VR (I R 63 ) ,VR(IR64) ,VR(IR65), 

2 VR (I RA7) , VR (IR 20 ) ,VR (IR51) ,VR (IR 58 ) ) 

Begin iteration 

I I 1 = 1 

DO 195 1=1, ND 
TOLD (1)=0.0 
195 CONTINUE 

CALL MNU (NNODE ,5»DD) 

Form stiffness matrix. 

C 

CALL ASSMBL (I I I , IPT(IPl) , IPT(IP2) , I PT (I P3) , I PT (I P4) , IPT (IP5) , 

1 I PT ( I P9> , VR ( I R 1 ) , VR (IR2) ,VR(IR3) ,VR(IR6) ,VR(IR8) , 

2 VR (I R12) , VR ( I R 1 1*) , 

3 VR ( I R 1 5) , VR ( I R 1 6) , VR ( I R 1 9) , 

4 VR (IR21) , VR (I R23) ,VR { I R24) , VR (l R1 9) , VR (I R4 1 ) , VR ( I R50) , 

5 VR (IR52) , VR ( I R66) ,VR(IR67) , VR (IR68) ,VR (IR74) ) 

Calculate the equivalent load vector 

CALL I NLDV ( 1 PT (I PI) , VR ( I R 1 ) ,VR(IR2) ,VR(IR3) , 

1 VR ( I R 1 4) , VR ( I R22) , VR ( I R28) , VR ( I R4) ) 

C 

DO 200 1=1, NT 
DLDINC (I)=DD1 (I) 

C WRITE (6,*) I,' DD1 { 1 ) = ' ,DD1 (I) 

200 CONTINUE 
C 

CALL REDC(IPT(IP4) ,VR(IR8) ,VR (I R12) ) 
c 

DO 570 1=1, ND 
DD1 (l)=0.0 
EXLVC (l) =D (l) 

C WRITE (6,*) l,' D ( I ) = 1 , D ( I ) 

570 CONTINUE 

C WRITE (6,*) ITRLM 

C WRITE (6,36) III 

36 FORMAT ('THIS IS THE ITERATION ’,113) 

C 

571 CONTINUE 
C 

c 

DO 444 1=1, ND 
TDLD (I) =0.0 
DO 444 J=1 ,ND 

TDLD (l)=TDLD (l)+A (I , J) *D (J) 

444 CONTINUE 
C 

DO 505 1=1, NT 
DO 505 M=1 ,ND 

IF (I .EQ.L (M)) THEN 
DLOADT ( I ) =TDLD (M) 

END IF 

505 CONTINUE 
C 

c WRITE (6,*) 'Temperature related dis.placement: 1 
DO 506 1=1, NNODE 
DO 506 J=1 ,5 

VF (I ,J)=DLOADT(l*5~5+J) 

DD { I , J) =DD ( I , J) +VF ( I , J) 

C WRITE (6,*) 1 1 = ' , 1 , 1 1 ,VF (I , 1) , ' 1 ,VF (1 ,2) , 1 ',VF(I,3) 

506 CONTINUE 
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Estimate the new coordinates 


TINC=1 .0 

IF (I I I .EQ.NANM) STOP 

DO 900 1=1 ,NN0DE 
XX (l)=XX (l)+VF (i , 1) 

YY ( I ) =YY ( I ) +VF (1,2) 

ZZ (l)=ZZ (I)+VF (1,3) 

TMP=0 .0 
DO 903 J-l.,3 

GCL3 ( I ,J)=GCL3(I , J) +TI NC* (-GCL2 (I ,J)*VF (I,4)+GCL1 (l,J)*VF (1 ,5)) 
TMP=TMP+GCL3(I , J) *GCL3 (I ,J) 

903 CONTINUE 

TMP=TMP**0.5 
DO 902 J= 1 , 3 

GCL3 0 ,J)=GCL3(1 , J) /TMP 
902 CONTINUE 

C WRITE (6,*) 1 1 = ' , I , ' ' ,VF (I , V) , ' ' ,VF (1 ,2) , ' 1 ,VF (1,3) 

C WRITE (6,26?) I iXX (I) ,YY (I) ,ZZ(I) 

900 CONTINUE 

CALL CNND(VR(IR60) ,VR(IR6l) ,VR(IR62)) 

C 

C Calculate internal forces 
C 

CALL I NTFRC (I II , I PT (I PI) ,VR(IR1) ,VR(IR2) ,VR(IR3) , 

1 VR ( I R 1 4) ,VR (IR22) ,VR (IR28) , VR ( I R9) ) 

SHRINK THE INTERNAL FORCE VECTOR 

DO 500 1=1, NT 

WRITE (6,*) 1 PLD ' ,l,‘ 1 ,PLD ( I ) 

DO 500 M=1,ND 

IF (I .EQ.L («)) THEN 

FRCI NC (M) =PLD ( I ) -FRCO (M) 

ACTFRC (M) -PLD (I) 

504 FORMAT ('THE LOAD COL 0, IS: MI2,' ' .2F12.5) 

END IF 
500 CONTINUE 

DO 502 1=1, ND 

WRITE (6,*) !,' RD PLD*', ACTFRC (I) DD1 = ',DD1(I) 

502 CONTINUE 

Check whether to step out the equi 1 ibr ium iterations 

CALL CR I TR2 ( I I I , ND , VR ( I R8) , VR ( I R42) , VR ( I R59) . VL I N I T , I CNC 1 ) 

C 

IF (I I I .EQ.40) THEN 

WRITE (6,*) '(TER LIMIT IN TEM. REACHED, STOP' 

STOP 
END IF 

IF (ICNC1.EQ.0) THEN 
I CTMP=0 

C (The switch to the effects of the change of temperature is off) 
DO 700 1=1, ND 

C WRITE (6,*) I,' 3 > D='.D(I),' FRCINC’ ,FRCINC(I) 

D (I) =-FRCI NC (I) 

700 CONTINUE 
111=11 1+1 
GOTO 571 
END IF 
C 

701 CONTINUE 

I SEC=I SEC+1 

IF (ISEC.GT.10) I SEC=10 
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K=1 

00 589 1=1 ,NN0DE 
DO 589 -1=1,5 

IF (I 10(1 ,J) .EQ.O) THEN 
ACMD I S (K) =ACMD I S (K) +0D ( I , J) 

D1 ( I , J) =ACMD I S (K) 

K=K+1 
END IF 
589 CONTINUE 
C 

DO 689 1=1 ,NN0DE 
DO 689 J=1 ,5 
DD (I , J)=0.0 
689 CONTINUE 
C 

ITYPE=2 

Update some of the variables if equilibrium iteration is successed. 

CALL UPDT ( I TYPE , I PT ( I P3) ,VR(IR1) ,VR(IR2) ,VR(IR3) ,VR(IR12) , 

1 VR (I R1 5) ,VR(IR27) ,VR(IR1»3) ,VR(IRifif) ,VR(IRl*5) , 

2 VR (I Rl»6) ,VR(IR1*7) , VR ( I R20) ,VR(IR48) ,VR(IRlf9) , 

3 VR (IR51) , VR ( I R58) ,VR(IR60) ,VR(IR6l) ,VR(IR62) , 

if VR (I R63) , VR ( I R64) ,VR(IR65) , VR ( I R75) ) 


Data output 

CALL OUTPUT (TTLD.VR ( I R15) , VR ( I R75) , VR ( IR7 D , VR ( I R 1 ) ,VR(IR2) , 
1 VR ( I R3) ) 

IF (NITR.EQ.NUM) THEN 


Write necessary data for further use. 

CALL WTCDT (VR ( I R27) , VR ( I R20) , VR ( I R43) , VR ( I RMf) , 

1 VR ( I Rif5) , VR (I Rl) , VR ( I R2) , VR (I R3) » 

1 vr(ir47) ,vr(irio) ,vr(ir 5 D ,vr(ir 58 ) ,vr(ir6o) , 

3 VR (I R6l) , VR (IR&2) , VR ( I R 1 5) ,VR(IR71) ,VR(IR75)) 

END IF 

RETURN 

END 


Subroutine is used to calculate the equivalent load vector 
caused by the change of temperature. 

SUBROUTINE INLDV (I EL, XX, YY.ZZ, 

1 VF,PD,PDL,PLD) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION XX (1) ,YY(1) ,ZZ(1) ,VF (NN0DE.5) » PD ( 1 ) ,PDL(1) ,PLD(1) 
DIMENSION H (2) ,P(2) ,R(8) ,S (8) ,X(8) ,Y(8) ,Z(8) ,ND(8) , l EL (NELM.8) , 
1 VFE(lfO) 

C 

COMMON /SCHALR1/ NELM.NNODE.NT 

COMMON /PNTRIN/ I PI , 1P2, IP3, IPA, IPS, I P6, IP?, IP8, IP9, IP 1.0 
COMMON /PNTRRL/ IR1 , IR2, IR3, IRif, IR5, 1 R6 , IR7, IR8, IR9, 1 RIO, 

1 IR11, IR12, IR13, IRlif, IR15, IR16, IR17, IR18, 

2 IR19, IR20, IR21 , IR22, IR23, IR2if, IR25, IR26, 

3 IR27, IR28, IR29, IR30, 1 R31 , 1 R32, 1 R33, 1 R3i*> 

h IR35, IR36, IR37, IR38.IR39, IRlfO, IRlfl , IR42, 

5 IR43, IR44, IR45, IR46, IR47, IR48, IR49, IR50 

COMMON /UNIFBD/ I R51 , I R52, I R53, I R54, I R55, I R 56 , I R57, I R58, I R59 
COMMON /DIRCS/ IR60, IR6l , IR62, IR 63 , IR64 , IR 65 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT, TIN IT 
COMMON /RLVEC/ VR ( 1 ) 
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COMMON / 1 NTVEC/ I PT ( 1 ) 

COMMON /A3/ CL 1 (8) , CM1 (8) , CN 1 (8) , CL2 (8) , CM2 (8) , CN2 (8) , 
CL3 (8) , CM3 (8) , CN3 (8) 

DO 30 1=1, NT 
PLD (I) =0.0 
30 CONTINUE 

DO 700 1=1 , NELM 
1 1 = 1 EL (1.1) 

1 2=1 EL (1 ,2) 

I 3* I EL (1,3) 
lL=IEL(l ,b) 

1 5— I EL (1,5) 

1 6 = I E L ( 1 ,6) 

1 7=1 EL (1 ,7) 
l8=IEL (1,8) 


CALL UPILD (I , 11 , 12, 13, IL, 15, 16, 17, I8,VR(IR1) ,VR(IR2) ,VR(IR3) , 

1 VR(IRIL) , VR (I R22) ,VR(IR28) ,VR(IR60) ,VR(IR6l) ,VR(IR62)) 


DO 700 J= 1 ,8 
DO 700 K=l,5 
JJ= I EL (I ,J)*5-5+K 
Jl=J*5-5+K 

PLD (JJ) =PLD (JJ) +PD (J 1 ) 

700 CONTINUE 
C 

RETURN 
END 

(END INLDV) 

Subroutine UPILD is used to evaluate the equivalent load vector 
caused by the change of temperature at every element. 

SUBROUTINE UP I LD (I L, 1 1 , 1 2, I 3, 1 b , 15, 1 6 , 1 7 , 1 8 , XX, YY, ZZ, 

1 VF,PD,PDL,GCL1 ,GCL2,GCL3) 

IMPLICIT REAL *8 (A-H.O-Z) 

IMPLICIT INTEGER *8 ( 1 — N) 

DIMENSION XX ( 1 ) ,YY( 1 ) ,ZZ(1) ,VF (NN0DE.5) ,PD(1) ,PDL(1) , 

1 H (2) , P (2) ,R( 8 ) , S ( 8 ) ,X ( 8 ) , Y ( 8 ) ,Z( 8 ) ,ND( 8 ) , 

2 VFE (bO) , GCL 1 (NNODE , 3) , GCL2 (NNODE , 3) , GCL3 (NNODE, 3) , 

3 HH (b) , PP (b) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /PNTRIN/ I PI , I P2, I P3, 1 PL, I P5, I P 6 , I P7 , I P 8 , I P9, I P10 
COMMON /PNTRRL/ I R1 , 1 R2 , 1 R3, 1 RL , I R5, 1 R 6 , 1 R7 , 1 R 8 , 1 R9, 1 RIO , 

1 IR11.IR12, 1 R 1 3 , IR1-4, IR15. 1 R 1 6 , IR17, IR18, 

2 I R 1 9 , IR 20 , IR21, IR22, IR23, IR2A.IR25, I R 26 , 

3 IR27, IR28, IR29, IR30, 1 R31 , 1 R32, IR33, IR3 1 *. 

b IR35, IR36, IR37, IR38, IR39, IRLO, IRAl , IRL 2 , 

5 IRL3, IRLL, IRL5, IR46, IRL7, IRl* 8 , IR49, IR50 

COMMON /UNIFBD/ I R51 , 1 R52, 1 R53, I R5 1 *, I R55, 1 R5&, I R57, 1 R58, 1 R59 
COMMON /DIRCS/ I R 60 , I R 6 l , I R 62 , I R63» I R64, I R 65 
COMMON /UNICT/ NCONS, MODEL, ETAA,TDELT,TI N IT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON /I NTVEC/ IPT(l) 

COMMON /CONTN/ I NS I DT, KPDT.DTLM1 

COMMON /A3/ CL 1 ( 8 ) , CM1 ( 8 ) , CN 1 ( 8 ) , CL2 ( 8 ) , CM2 ( 8 ) , CN2 ( 8 ) , 

1 CL3 ( 8 ) ,CM3 ( 8 ) ,CN3 ( 8 ) 

c 
c 

ND (1) =1 1 
ND (2) =12 
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ND (3) = 1 3 
ND(4)=l4 
ND (5) =15 
ND (6) = 1 6 
ND (7) -17 
ND (8) = I 8 


DO 250 1=1,8 
X(I)=XX (ND (I) ) 

Y ( I ) =YY (ND(I)) 

Z (I ) =ZZ (ND (I) ) 

C WRITE (6,260) I ,X (I) ,Y (I) ,Z (I) ,ND (I) 

DO 250 J=1 ,5 
VFE(l*5-5+J) =VF (ND (I) ,J) 

250 CONTINUE 

260 FORMAT (IX, 'THE COORDINATES OF NODE ' , 1 2, IX, 1 ARE : 1 , 3F 1 2 .8, 1 I 2) 


R (1) =-l .0 
S(l)=- 1.0 
R (2) =1 .0 
S (2) =-1.0 
R (3) =1 .0 
S (3) = 1 .0 
R (4) =-1.0 
S (4) =1 .0 
C 

R(5) =0.0 
S(5)=-1.0 
R (6) =1 .0 
S (6) =0.0 
R (7) =0.0 
S (7) =1 *0 
R (8) =-l .0 

s ( 8 ) =0.0 

c 

C WRITE (6, 157) IL 

C 

DO 344 1=1,8 

CL 1 ( I ) =G CL 1 (ND (I) ,1) 
CM1 ( I ) =GCL 1 (ND (I) ,2) 
CN1 (I) =GCL 1 (ND ( I ) ,3) 
CL2 (l)=GCL2 (ND (I) ,1) 
CM2 ( I ) =GCL2 (ND (I) ,2) 
CN2 (l)=GCL2 (ND (I) ,3) 
CL3 (I) =GCL3 (ND (I) , 1) 
CM3 (I) =GCL3 (ND (I) ,2) 
CN3(I)=GCL3(N0(I) ,3) 
344 CONTINUE 
C 

DO 348 1=1,40 
PD (I ) =0.0 
348 CONTINUE 
C 

H (1) =1 .0 

H (2) =1.0 

P(l) =0.577352692 
P (2) =-P (1) 

C 

c HH( 1 ) =0.3478548451 

C HH (2) =H (1) 

C HH(3)=0. 6521451548 

C HH (4) =H (3) 

c pp ( 1) =0. 861 1363115 

C PP (2) =-P (1) 
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P p (3) =0.3399810435 
PP (4) =-P ( 3 ) 


DO 150 1=1,2 
DO 150 J=1 ,2 
DO 150 K= 1 ,2 
U=P (1) 

V=P (J) 

W=P (K) 

CALL INTFC (l L.ND, I , J,K,U,V,W,X,Y,Z,VR (IR14) ,VR(IR28) , 

1 DETJ.VR {IR3D ,VR(IR32) ,VR(IR33) ,VR(IR29) , 

2 VR(IR37) ,VR(IR38) ,VR (IR36) ,VR (IR39) , VR (IR40) , 

3 VR ( I R30) , VR (IR 20 ) ,VR(I R47) , VR ( I R54) , VR ( 1 R55) ) 


DO 150 M= 1 , 40 

PD (M) =PD (M) +H ( I ) *H (J) *H (K) *PDL (M) *DETJ 
150 CONTINUE 


RETURN 

END 

C (END UPILD) 

C 

C Subroutine UPILD is used to evaluate the equivalent load vector 
C caused by the change of temperature at every integer at Ion point. 

C 

SUBROUTINE INTFC (I L, NO, li , JJ , KK , R, S ,T, X, Y , 2, VF , PDL , DETJ , BL , 

1 TBL,TMPBL,VFE,TL,TT,TMP, EM, EM2,PDLL, SIGMA, 

1 UPS I G , SVT3D , SVBLD) 

C 

c 

IMPLICIT REAL *8 (A-H.O-Z) 

IMPLICIT INTEGER *8 (l-N) 

DIMENSION X ( 8 ) , Y ( 8 ) ,Z( 8 ) ,VF (NNODE ,5) , PDL (1 ) , 

1 BL (6 , 40) ,TBL (40,6) ,TMPBL(6,40) ,VFE (40) , 

A ( 8 ) ,B ( 8 ) , C ( 8 ) , D ( 8 ) ,E ( 8 ) , G ( 8 ) ,ND ( 8 ) , 

TL ( 6 , 6 ) ,TT ( 6 , 6 ) ,'TMP ( 6 , 6 ) ,EM( 6 , 6 ) ,EM2 ( 6 , 6 ) , 

PDLL (40, 1) , S I GMA (NELM, 2 ,2,2,9) , UPS I G (NELM, 2, 2, 2, 9) . 
s I G (3, 3) , GRT (3 , 3) »DV (3,3) , SVT3D (NELM, 1 , 2,2,144) , 

SSI (3,3) ,SS2 (3,3) » SS 3 (3 » 3) ,AA (3,3) ,SA ( 6 , 1) ,STA (6,1) , 

SD ( 6 , 1 ) , G AU (3 , 3) , DGR (3 , 3) , DGRT (3 ,3) »EM3 ( 6 , 6 ) , 

GRD (9) ,GR(3,3) ,DW(3,3) .SVBLD (NELM, 2, 2, 2, 24) 

COMMON /SCHALR1 / NELM, NNODE , NT 

COMMON /PNTR IN/ I P 1 , I P2 , I P3 , I P4 , I P5 , I P6 , I P7 , I P8 , I P9 , I P 1 0 
COMMON /PNTRRL/ I R1 , 1 R2 , 1 R3, 1 R4, 1 R5 , 1 R6 , 1 R7 , 1:R8, 1 R9, I R 10, 
IR11,IR12,IR13,IR14,IR15,IR16,IR17,IR18, 

I R 1 9 » IR 20 , IR 21 , I R 22 , IR 23 , 1 R24 , IR 25 , 1 R 26 , 

IR27, IR 28 , IR29, IR30, IR31JR32, IR33, IR34, 

IR35, IR36.IR37.IR38, IR 39 , IR40, IR41, IR42, 

IR43, IR44, IR45, IR46, IR47, IR48, IR49, IR50 
COMMON /UNIFBD/ I R51 , I R52 , I R53 , I R54 , I R55 , I R5& , I R57 , I R58 , I R59 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON / I NTVEC/ IPT(l) 

COMMON /GEO/ TO 
COMMON /ABDFST/ I SEC 
COMMON /CONTN/ I NS I DT, KPDT , DTLM1 

COMMON /A3/ CL 1 ( 8 ) ,CM1 ( 8 ) ,CN1 ( 8 ) ,CL2 ( 8 ) ,CM2 ( 8 ) , CN2 ( 8 ) , 

1 CL3 ( 8 ) , CM3 ( 8 ) ,CN3(8) 

COMMON /TMPEF/ I DO , NTEM, N I TR, NANM, CEXPN ,TMM I N ,TMI NC .TMMAX ,TMPP 


C 


DO 10 1=1,8 
A ( I ) =0 . 0 
B ( I ) =0 . 0 
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c (r) =0.0 

D (I) =0.0 
E ( I )=0.0 
G (0=0.0 

10 CONTINUE 


CALL GIOW (R, S, T,TO, X , Y , Z.OETJ , A,B,C,D, E,G) 

C 

C Get the geometr ic property at the i ntegrat ron point. 

C 

CALL MNU(6,40’,BL) 

DO 38O 1=1,8 

c 

BL (1, 1*5-4) “A ( 1 ) 

BL (if, l*5-lf) =B (I) 

BL (6, 1*5-4) =C 0) 

c 

BL(2,I*5-3)=B(I) 

BL (if, 1*5-3) = A (l) 

BL (5, 1*5-3) =C (t) 

C 

BL (3, 1*5-2) =C (f) 

BL (5, 1*5-2) =B (() 

BL (6, 1*5-2) =A (I) 

C 

BL (T, l*5-T>=-D (l)*CL2(l) 

BL (2, 1*5-1)— E (l)*CM2 (I) 

BL(3,r*5-i)**G(i)*CN2(i) 

BL (if, I *5-1) “~E (l)*CL2(r)-D(l) *CM2 (f) 

BL GCf)*CH2 (!)-£ (l)*CN2(l) 

BL (6, I *5-1) — B (1) *CN2 (I ) -G ( 1 ) *CL2 (!) 

C 

BL (1 , I *5) =0(1) *CL 1 (f) 

BL (2, l*5)=E (I)*CM1 (t) 

BL (3, f*5)=G (I) *CNt (i) 

BL (4 , 1 *5) =E ( I ) *CL 1(1) +0 (1 ) *CM ( 1 ) 

BL (5, i*5)=G(l)*CMl (l)+E (l) *CN1 (I) 

BL(6,1*5)=D( I ) *CN1 (l)+G (() *CL1 (1 ) 

C 

380 CONTINUE 
C 

CALL MNU(M,TL) 

c 

CALL ROTMTRX (R,S,X,Y,Z,TL) 

C 

C Get the rotation transformation matrix [T] . 

G 

CALL TRANSP (6 , 6, TL ,TT) 

C 

C tt = t transpose, 

C 

SA(1,T)»CEXPN*TMINC 
SA (2, 1) =CEXPN*TMl NC 
SA(3,l)=CiXPN*TMINC 
SA (4,1) =*0.0 
SA (5, 1) =0.0 
SA (6, 1)=0.0 
C 

If ((NCONS.EQ.l) .AND, (111 .GT. 2)) THEN 
GALL MMT (6 ,6, 1 ,EM2 , SA, I M3) 

ELSE 

CALL MMT (6,6,1, EM,SA, EM3) 

END IF 
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C WRITE (6,*) (EM3d ,1) , 1 = 1,6) 

C Get the elastic costant and will be changed by further consideration. 

C ' ' " * " 5 ' ' ' ! ' 

CALL MMT(6,6,1,TT,EM3,TMP) 

C WRITE (6,*) (TMP(I ,1) , 1 = 1,6) 

c 

c 

DO 720 1=1,6 

STA (I , 1) =TMP (! , 1) 

720 CONTINUE 
C 

CALL TRANSP (6 , 40 , BL ,TBL) 

CALL MMT(40,6, 1 ,TBL,STA,PDLL) 

C 

DO 80 1=1,40 

PDL (I) =PDLL (I , 1) 

80 CONTINUE 
RETURN 
END 

C ( end INFC) 

C 

C 

SUBROUTINE CRITR2 (I I , ND , DD 1 , FRC I NC, ACTFRC, VL I MN , I CNC1) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGERS (I -N) 

C 

C Subroutine CRITR2 is to build an exit criteria for the equilibrium 
C iterations* 

C input: 

C i i = The i i 1 th number iteration 

C DLDINC * The load increament 

C DLOADT - Te load level at that iteration. 

C PLO = The nodal force in last iteration 

C DVEC ® The unknown solved in last iteration 

C VLINIT = the criteria value calculated in the first iteration. 

C Output: 

C ICONCL “ The conclusion : Exit the loop or not. 

C 1 = exit 

C 0 - Keep inside the loop. 

C 

DIMENSION DD1 (1) , FRCI NC (1) .ACTFRC (1) 

COMMON /PNTRIN/ I P 1 , I P2 , I P3, I P4, 1 P5, I P6 , I P7, I P8, I P9, I P10 
COMMON /PNTRRL/ IR1, IR2, IR3, IR4, IR5, IR6, IR7, I R8 , IR9. IR10, 

1 IR11, IR12.IR13. IR14.IR15.IR16, IR17. IR18, 

2 IR19, IR20, IR21, IR22, IR23, IR24, IR25. IR26, 

3 IR27, IR28, IR29, IR30, IR31, IR32, IR33. IR34, 

4 IR35, IR36, IR37, IR38, IR39. IR40, IR41 , IR42, 

5 IR43, IR44.IR45.IR46, IR47, I R48 , IR49, IR50 

c 

COMMON /UNIFBD/ IR51 , IR52, 1R53. IR54, IR55. IR56, IR57, IR58, IR59 
COMMON /SCHALR1/ NELM.NNODE.NT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON /INTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT, DTLAM.SGN, I PP.TROOT, ASO.SP 

C 

A I NS=0 . 0 
C0EFF=70.0 
VL I MN0=VL I MN 
VAL=0 .0 

IF(II.EQ.l) THEN 
VL I NT 1 =0 . 0 
DO 10 1=1, ND 

TEMP=FRC I NC (I ) 

C AINS=AINS+TEMP 

VL I MN=VL I MN+TEMP*TEMP 
IF (I.LT.6) THEN 
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WRITE (6,90) I 1,1,001 (I) ,FRCINC(I) .TEMP, ACTFRC (I) 
END IF 

30 FORMAT (' I I , I ,D (I) , FRC INC, TEMP: * , 2 1 4 , 4F 1 2 . 3) 

10 CONTINUE 

VL I MN=SQRT (VLIMN) 

VAL=VL I MN 
ELSE 

DO 20 1=1, ND 

TEMP=-FRCINC (I) 

VAL=VAL+TEMP*TEMP 
IF (I.LT.6) THEN 

WRITE (6,90) N,l, DD1 (I) , FRC I NC ( I ) , TEMP, ACTFRC ( I) 
END IF 

90 FORMAT ('11,1,0(1), FRC I NC, ACTF : ' ,2 I4.4F 12.4) 

20 CONTINUE 

VAL=SQRT (VAL) 

END IF 

1 CNC 1 =0 

IF (VLIMN. GT. 10.0) VLIMN=10.0 
IF ((VAL*COEFF) .LT. VLIMN) ICNC1=1 
WRITE (6,50) VAL*COEFF, VLIMN, ICNC1 
50 FORMAT (' VAL l.CR I Tl.CONCL ARE: 1 , 2F 14.3* 1 1 3) 


C 

c 

c 

c 


c 


RETURN 

END 

Subroutine RDCDT reads necessary data saved at last execution. 
So the program can stop and resume the previous work. 

SUBROUTINE RDCDT (ACMD I S , S I GMA, XXI , YY 1 , ZZ 1 , XX, YY , ZZ , UPS I G , 

1 FRCO, BETA, UPBET.GCLl ,GCL2,GCL3,UCL1,UCL2, 

3 UCL3,D1,TLTY,ANGL) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION DLOAD(I) ,DD1 (1) , DD2 (1) ,PLD(1) ,ACMDIS(1) , ANGL (1) , 

1 S I GMA (NELM, 2, 2, 2 , 9) ,XX (1) , YY (1) , ZZ (1) , XX 1 (1) ,YY1 (1) , 

2 ZZ1 (1) , UPS I G (NELM, 2 , 2 , 2 , 9) ,FRCINC(1) ,FRC0(1) , 

3 BETA (NELM, 2, 2, 2, 12) ,UPBET (NELM, 2, 2, 2, 12) , D 1 (NN0DE.5) , 

4 GCL 1 (NNODE, 3) ,GCL2 (NNODE, 3) , GCL3 (NNODE , 3) . 

5 UCL 1 (NNODE, 3) , UCL2 (NNODE, 3) ,UCL3 (NNODE, 3) ,TLTY (1) 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT.NSTEP.NHBW.COEFl ,C0EF2,NSH0W1 ,NSH0W2, 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 P3, 1 P4, 1 P5, 1 P6, I P7, 1 P8, 1 P9, 1 P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, 1 R4 , IR5, IR6, IR7, IR8, IR9, I RIO, 

1 IR1 1 , IR12, IR13, IR14, IR15.IR16, IR17, IR18, 

2 IR19, IR20.IR21, IR22,IR23, I R24, IR25, I R26* 

3 IR27, IR28, IR29, IR30, IR31, IR32, IR33. 1 R34, 

4 IR35. IR36. IR37, I R38, IR39. I R40 , I R41 , IR42, 

5 IR43, IR44, IR45, IR46, IR47, IR48, IR49, IR50 
COMMON /UNIFBD/ IR51 , IR52, IR53, IR54, IR55. I R5& . I R57 , IR58, IR59 
COMMON /TMPEF/ I DO,NTEM,N ITR.NANM, CEXPN,TMMIN,TMINC,TMMAX,TMPP 
COMMON /DISV1/ IR70, IR71, IR72, IR73. IR74, IR75 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /RLVEC/ VR (1) 

COMMON /INTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT.DTLAM.SGN, IPP,TROOT,ASO,SP 

COMMON /CONTN/ I NS I DT, KPDT, DTLM1 

COMMON /SQ/ SQQ 

COMMON /DISCT/ NDC.NDBC 

COMMON /OUTVR/ NPT.NPV 

COMMON /CREEP/ I CRP , NBCRP , NBDN , CRPTM, I PON 
COMMON /CNTR/ I CNTR 
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READ (i+ ,*) ICNTR 
READ (4,*) TROOT 
READ (4,*) DTLM1 
READ (4,*) SQQ 
READ (4,*) TMPP 
C 

IF (ICRP.EQ.l) THEN 
READ (4,*) NBDN , CRPTM 
END IF 

C 

DO 689 1=1, NNODE 

READ (4,*) . XX (I ) , YY (I) ,ZZ(I) 

WRITE (2,*) XX ( I ) ,YY(I) ,ZZ(I) 

XXI (l)=XX (I) 

YY1 (l ) =YY ( I ) 

ZZ1 ( I ) =ZZ ( I ) 

689 CONTINUE 

DO 687 1=1, NNODE 

READ (4,*) (GCL1 (t,J) , J=1 ,3) 

READ (4,*) (GCL2 (I , J) , J=1 , 3) 

READ (4,*) (GCL3 (I , J) ,>1,3) 

DO 688 >1,3 

UCL1 (I , J) =GCL1 (t,J) 

UCL2 (I , J) =GCL2 (I , J) 

UCL3 (I ,J)=GCL3(I ,J) 

688 CONTINUE 

687 CONTINUE 

C 

DO 269 1=1 ,NELM 
DO 269 >1 ,2 
DO 269 K— 1,2 
DO 269 M=1 , 2 
DO 269 N=l,9 

READ (4,*) SIGMA (I ,J,K,M,N) 

WRITE (2,*) SIGMA(I ,J,K,M,N) 

UPSIG(I , J , K,M,N) =S I GMA (I ,J,K,M,N) 
269 CONTINUE 
C 

DO 669 1=1 ,NEQT 
READ (4,*) ACMDIS(I) 

WRITE (2,*) ACMDIS (I) 

669 CONTINUE 
C 

DO 730 1=1 ,NEQT 
READ (4,*) FRCO (I) 

WRITE (2,*) FRCO (I ) 

730 CONTINUE 
C 

IF (NCONS.EQ.l) THEN 
DO 299 1=1 ,NELM 
DO 299 J=1 , 2 
DO 299 K=1 , 2 
DO 299 M=1 ,2 
DO 299 N=1 , 12 

READ (4,*) BETA (I , J,K,M,N) 

WRITE (2,*) BETA (I , J,K,M,N) 
UPBET(I , J,K,M,N) =BETA (I ,J,K,M,N) 
299 CONTINUE 
END IF 

IF(NDC.EQ.l) THEN 
DO 320 1=1, NNODE 
DO 320 J=1 ,5 

READ (4,*) D1(I,J) 

320 CONTINUE 

DO 420 1=1 , NDBC 
READ (4,*) TLTY(I) 
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1*20 CONTINUE 

I F (NPT.EQ. 6 ) THEN 
DO 620 1=1 ,NDBC 
READ (1*, *) ANGL(I) 

620 CONTINUE 
END IF 
END IF 
C 
C 

RETURN 

END 

C END RDCDT 
C 

C Subroutine WTCDT write necessary data in file wrt. 

C So the program can resume the execution when desired. 

C 

SUBROUTINE WTCDT (ACMD I S, S I GMA.XXl , YY1 ,ZZ1 ,XX, YY.ZZ.UPS I G, 

1 FRC0,BETA,UPBET,GCL1,GCL2,GCL3,D1,TLTY,ANGL) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER* 8 (I-N) 

DIMENSION DLOAD(l) ,DD1 (1) ,DD2(1) ,PLD(1) ,ACMDIS(1) , ANGL (1) , 

1 S I GMA (NELM, 2 , 2 , 2 , 9) ,XX(1) ,YY(1) ,ZZ(1) ,XX1 (1) ,YY1 (1) , 

2 ZZ1 (1) , UPS I G (NELM, 2, 2 , 2, 9) , FRC I NC (1) ,FRCO(l) , 

3 BETA (NELM ,2, 2, 2, 12) .UPBET (NELM, 2, 2, 2, 12) ,TLTY (1) , 

k GCL1 (NNODE, 3) »GCL2 (NNODE ,3) , GCL3 (NNODE , 3) ,D1 (NNODE ,5) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /SCHALR2/ NEQT.NSTEP.NHBW.COEFl ,C0EF2,NSH0W1 .NSH0W2, 

1 NSH0W3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, 1 >3, 1 Pl», I P5, 1 P 6 , 1 P7, 1 P 8 , I P9, 1 P10 
COMMON /PNTRRL/ IR1 , IR2, IR3. I R4 . IR5, IR 6 , IR7, IR 8 , IR9, IR10, 

1 IR11, IR12, 1 R 1 3 » IRll*> I R 1 5 » I R 1 6 , 1 R 1 7 » I R 1 8 , 

2 IR19, IR20, IR21.IR22, IR23, IR24, IR25, IR26, 

3 IR 27 , IR 28 , IR29, IR30, IR31, IR32, IR33, IR3 1 *, 

i* IR35. IR36. IR37, IR38, IR39, IR40, IRlfl, IR1*2, 

5 IR1*3, IR1»1», I r 45» I R46, IR1»7, 1 R48 . IRl»9, IR50 

COMMON /UNI FBD/ I R5U R52, 1 R53, 1 R5 1 *. I R55. 1 R56, 1 R57 , I R58 , 1 R59 
COMMON /DISV 1 / IR70, IR71, IR72, IR73. IR74, IR75 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT,DTLAM,SGN, I PP.TROOT, ASO.SP 

COMMON /CONTN/ I NS I DT.KPDT, DTLM1 

COMMON /SQ/ SQQ 

COMMON /DISCT/ NDC.NDBC 

COMMON /OUTVR/ NPT.NPV 

COMMON /CREEP/ I CRP,NBCRP,NBDN,CRPTM, I PON 
COMMON /CNTR/ I CNTR 

COMMON /TMPEF/ IDO,NTEM,NITR,NANM, CEXPN,TMMIN,TMINC,TMMAX,TMPP 
C 

WRITE (7,*) I CNTR 
WRITE (7,*) TROOT 
WRITE (7,*) DTLM1 
WRITE (7,*) SQQ 
WRITE (7,*) TMPP 
C 

IF (ICRP.EQ.l) THEN 
WRITE (7,*) NBDN,CRPTM 
END IF 

DO 689 1 = 1 , NNODE 

WRITE (7,*) XX (I) ,YY (I) ,ZZ (I) 

689 CONTINUE 

DO 687 1=1, NNODE 
WRITE (7,*) (GCL1 (l,J) ,J= 1 , 3 ) 

WRITE (7,*) (GCL2(I,J) ,J= 1 , 3 ) 

WRITE ( 7 ,*) (GCL3 (I , J) , J=1 , 3) 

687 CONTINUE 
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DO 2b3 ! = 1 , NELM 
DO 2fc>3 >‘='1,2 
DC 269 K=1 , 2 
DO 2fe3 M= 1 . 2 
DO 269 N= 1 , 9 

WRITE (7 , *) SIGMA (I , J,K,M,N) 
769 CONTINUE 

DO fa6y ! = 1 , M E QT 

WRITE (7,*) ACMDIS(I) 

66 9 CONTINUE 

DO 730 .1*1 ,NEQT 
WRITE (7,*) FRCO(I) 

730 CONTINUE 


IF (NCONS.EQ.l) THEN 
DO 299 1=1 ,NELM 
DO 299 J— 1*2 
DO 299 K= 1 , 2 
DO 299 M=1 , 2 
DO 299 N=1 , 12 
WRITE (7,*) BETA (I , J,K,M,N) 
299 CONTINUE 
END IF 

IF(NDC.EQ.l) THEN 
DO 320 1=1 ,NNODE 
DO 320 J=1 ,5 

WRITE (7.*) Dl(l, J) 

320 CONTINUE 

DO 420 1=1 ,NDBC 
WRITE (7,*) TLTY(I) 

420 CONTINUE 

IF(NPT.EQ.6) THEN 
DO 620 1=1 ,NDBC 
WRITE (7,*) ANGL { I ) 

620 CONTINUE 
END IF 
END IF 
C 
C 

RETURN 

END 

C END WTCDT 


NEXT SUBROUTINE IS USED TO UPDATA THE DIRECTION 
COSINES OF VECTOR VI AND V2 AT EVERY NODE. 

INPUT: GCL3 
OUTPUT: GCL1.GCL2 

SUBROUT I NE CNND (GCL 1 , GCL2, GCL3) 

C 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION GCL1 (NN0DE.3) ,GCL2 (NNODE , 3) , GCL3 (NN0DE.3) 
COMMON /DIRCS/ IR60, IR6l , IR62, IR63, I R64 , IR65 
COMMON /SCHALR1/ NELM, NNODE , NT 
COMMON /RLVEC/ VR ( 1 ) 

COMMON / 1 NTVEC/ IPT(l) 

C 

C 

DO 10 1=1, NNODE 
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CMD= (GCL3 (I , 1) *GCL3 (I , D+GCL3 (1.3) *GCL3 (1 ,3) ) **0.5 

GCL1 (1 , 1) -GCL3 (1*3) /CMD 

GCL1 (I ,2) =0.0 

GCL1 (1,3) “-GCL3 (1.1) /CMD 

TM1=GCL3(1 ,1)*GCL3 (1 , 1) +GCL3 0.3) *GCL3 (1,3) 

TM2=GCL3 ( 1 . 2) * (GCL3 ( I » .1) +.G.CL3 (1.3)) 

CMD= (TM1*TM1+TM2*TM2) **0.5 
GCL2 (I , 1) =0.0 
GCL2 (I ,2)=TM1/CMD 
GCL2 (1 ,3) —TM2/CMD 
10 CONTINUE 
C 

RETURN 

END 

C 

C Subroutine is for additional data input. 

C 

SUBROUT I NE RDSUP (GCL 1 , GCL2 , GCL3 , UCL 1 , UCL2 , UCL3. ANGL) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION GCL 1 (NNODE, 3) ,GCL2 (NN0DE.3) ,GCL3 (NNODE, 3) . 

1 UCL1 (NNODE, 3) »UCL2 (NNODE, 3) ,UCL3 (NNODE, 3) .ANGL (1) 

COMMON /DIRCS/ IR60, I R6 1 , IR62, IR63, IR6A, IR65 
COMMON /SCHALR1/ NELM.NNODE.NT 
COMMON /RLVEC/ VR (1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /DISCT/ NDC.NDBC 
COMMON /OUTVR/ NPT.NPV 
COMMON /RADS/ RR.ZL 
C 

DO 10 1=1 .NNODE 

READ (5,*) IA, (GCL3(I ,J) .0=1,3) 

10 CONTINUE 
C 

CALL CNND(VR(IR60) ,VR(IR6l) ,VR(IR62)) 

DO 20 1=1, NNODE 
DO 30 J-1,3 
UCL 1 (I , J)=GCL1 (I ,J) 

UCL2 (I , J) =GCL2 ( I , J) 

UCL 3 (I , J) -GCL3 (I ,J) 

30 CONTINUE 

C WRITE (6,*) I.' UCL1 = ' , (UCL1 (I , J) ,J=1,3) 

C WRITE (6,*) I,' UCL2=', (UCL2 ( I , J) , J-1,3) 

C WRITE (6,*) I,' UCL3=’, (UCL30.J) , J-1,3) 

20 CONTINUE 
C 

IF (NPT.EQ.6) THEN 
DO 50 1=1 ,NDBC 
READ (5,*) ANGL (I) 

WRITE (6,*) -ANGL (I) 

50 CONTINUE 

READ (5,*) RR 
END IF 

IF (NPT.EQ.A.OR.NPT.EQ.5.0R.NPT.EQ.6) THEN 
READ (5,*) RR.ZL 
END IF 
RETURN 
END 
C 

C Subroutine CB is to calculate the stiffness matrix at every 
C integeration point 
C 

SUBROUTINE CB (I I I , I L , JL , KL , ML , R , S ,T , X , Y , Z , DETJ , ESM, BN 1 , BN2 , 

1 BN3 , BL , TBL , TMPEM2 ,SS ,SS 1 , TMP , TL , TT , EM , EM2 , UPS I G , 

2 EXED , BOLD , BDSV, EM4) 

C 
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un 4^00 NJ — vn 4r-\wO 


IMPLICIT REAL *8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION X (8) ,Y(8) , Z (8) ,ESM(40,40) ,BN1 (40,40) ,BN2 (40,40) , 

1 BN3 (40,40) ,BL (6,40) ,TBL (40,6) ,TMPEM2 (6,40) ,SS (9,9) , 

2 SSI (9,9) ,TMP (6,6) ,TL (6,6) ,TT(6,6) ,EM(6,6) ,EM2 (6,6) , 
A (8) ,B (8) , C (8) ,0(8) , E (8) ,G(8) , SIG (3,3) , 

UPS I G (NELM, 2 ,2,2,9) ,EXED(40) , BDLD (1) , 
BDSV(NELM,2,2,2,6) ,EM4 (NELM, 2, 2, 2, 36) 

COMMON /SCHALRI/ NELM, NNODE , NT 

COMMON /PNTRIN/ I PI , I P2, 1 P3, 1 P4, 1 P5, IP6, 1 P7, 1 P.8, 1 P9, 1 PM) 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5.IR6, IR7, IR8, IR9, IR10, 

I R1 1 , IR12, 1 R 1 3 > I R 1 4 , 1 R 1 5 » 1 R 1 6 , 1 R 1 7 » 1 R 1 8 , 

IR19, IR20, IR21, IR22, IR23, IR24, IR25, IR26, 

IR27, IR28, IR29, IR30, IR31, IR32, IR33, IR34, 

IR35, IR36, IR37, IR38, IR39. IR40.IR4l.IR42, 

IR43, IR44, IR45, IR46, IR47, I R48, IR49, IR50 
COMMON /UNIFBD/ I R5 1 , IR52, IR53, 1 R5 1 * » »R55. IR56, IR57, IR58, IR59 
COMMON /UNICT/ NCONS , MODEL , ETAA ,TDELT,T I N IT 
COMMON /A3/ CL1 (8) ,CM1 (8) ,CN1 (8) ,CL2 (8) ,CM2 (8) ,CN2 (8) , 

1 CL3 (8) , CM3 (8) , CN3 (8) 

COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /GEO/ TO 
COMMON /ABDFST/ I SEC 
COMMON /CONTN/ I NS I DT, KPDT, DTLM1 
C 

I PR=0 

IF (IL.EQ. 1 .AND.JL.EQ.l .AND.KL.EQ. 1 .AND.ML.EQ. 1) IPR=1 

C 

CALL GEOM(R,S,T,TO,X,Y,Z,DETJ,A,B,C,D,E,G) 

C 

C WRITE (6,*) R,S,T,TO,DETJ 
C 

CALL MNU(6,40,VR(IR3D) 

C 

DO 440 1=1,3 
DO 440 J=1 , 3 

SIG (I ,J)=UPSIG(IL,JL,KL,ML, l*3“3+J) 

440 CONTINUE 
C 

C Get the linear part of matrix [B] . 

C 

DO 380 1=1,8 

BL (1 , 1*5-4) =A(I) 

BL (4, 1*5-4) =B (I) 

BL (6, 1 *5-4) =C (I ) 

C 

BL (2, 1*5-3) — B ( I ) 

BL (4, 1*5-3) =A(I) 

BL (5, 1*5-3) “C (I) 

C 

BL (3,1 *5-2) =C (I) 

BL (5, I *5~2) =B(I) 

BL(6, 1*5-2) =A(I) 

C 

BL (1 , I *5-1) =-D ( 1 ) *CL2 ( I ) 

BL (2, 1*5-1) =-E(l)*CM2(l) 

BL(3, l*5-l)=-G(l)*CN2(l) 

BL (4, I *5-1) =~E ( I ) *CL2 ( I ) -D ( I ) *CM2 ( I ) 

BL (5, l*5-l)=-G(l)*CM2(l) -E(l)*CN2(l) 

BL (6, I *5-1) =-D (I) *CN2 (I) -G (I) *CL2 (I) 

C 

BL (1 , I *5) =D ( I ) *CL 1 (I) 

BL (2, l*5)=E (I)*CM1 (I) 

BL(3,I*5)=G(I)*CN1 (I) 

BL (4, 1*5) =E (I) *CL1 (I)+D(I)*CM1 (I) 
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o o o o o o o o r> o o o o r> o o r> 


BL(5, 1*5) -G ( I ) *CM1 (l)+E (I)*CN1 (I) 

BL (6, 1 *5) =D (I) *CN1 (l)+6 (I) *CLl (I) 

380 CONTINUE 

CALL ROTMTRX (R,S,X,Y,Z,TL) 

Get the rotation transformation matrix [T] . 

CALL TRANSP (6,6,TL,TT) 

tt = t transpose. 

CALL MMX (6,6,6,TT,EM,TMP) 

CALL MMT (6,6,6,TMP,TL,EM2) 

I EEC=0 

IF (ISEC.EQ. 1 .OR. ISEC.EQ.2) IEEC=1 
I F ( (NCONS.EQ. 1) .AND. ((ISEC.NE.1) .OR. (INS1DT.EQ. 1)) . 

1 AND. ((I I I . EQ. 1 ) .OR. (ISEC.EQ.2))) THEN 
IF (MODEL. EQ. 1) THEN 

CALL B0DNERO I I , I L , JL, KL,ML,S I G, VR (I R28) ,VR(IR40) ,VR(IR3&) , 

1 VR(IR51) > VR ( I R53) ,VR(IR54) ,VR(IR55) . 

2 VR ( I R30) , VR ( I R5&) ,VR(IR57) , VR ( I R33) ) 

ELSE 

CALL WALKERO I I , I L , JL , KL ,ML , S I G, VR ( I R28) ,VR(IR40) ,VR(IR36) , 

1 VR (I R5l) , VR ( I R53) ,VR(IR54) ,VR(IR55) , 

2 VR (I R30) ,VR (IR56) ,VR(IR57) ,VR(IR33)) 

END IF 

END IF 

CALL TRANSP (6,40,BL,TBL) 

CALL TRANSP (6,40, VR (IR31) ,VR(IR32)) 

tbl = bl transpose. 

CALL MMT (6,6,40, EM2,BL,TMPEM2) 

CALL MMT(40,6,40,TBL,TMPEM2,ESM) 

IF(IPR.EQ.l) THEN 
DO 3 1=1, 40 

WRITE(6,*) I,' VESM(I,I) = ',ESM(I,I) 

3 CONTINUE 
END IF 


IF (NCONS.EQ. 1) THEN 
DO 350 1=1,40 
EXED (I) =0.0 
DO 349 J=1 ,6 

EXED(I)=EXED (l)+TBL (I , J) *BDLD (J) 

C WRITE (6,*) I.J,' EXED '.EXEDd),' TBL ',TBL(I,J),' 1 , BDLD (J) 

349 CONTINUE 

C I F (IPR.EQ. 1) WRITE (6, *) 'EXED IN CB: ' , EXED (I) 

C WRITE (6,*) I,' EXED IN CB-' ,EXED (!) 

350 CONTINUE 
END IF 

C 

CALL MNU (9»9*SS) 

C 

DO 520 1-1,3 
DO 520 J*1 ,3 
SS(I,J) -SIG(I.J) 

SS (1+3, J+3) =S I G (I ,J) 

SS (1+6, J+6) =S I G ( I , J) 

520 CONTINUE 


C 
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DO 530 1=1,3 

SSI (1, 1*3-2) =S I G (1 , 1) 

SSI (I , 1*3-1) “SI G (1 ,2) 

SSI (I , 1 *3) — S I G (1,3) 

f 

SSI (1+3, 1*3-2) =S IG (2, 1) 

SSI (1+3, 1*3-1)— SIG (2,2) 

SSI 0+3, 1*3) =S IG (2,3) 

c 

SSI (1+6, 1*3-2) =SIG (3, 1) 

SSI (1+6, l*3-l)“SIG(3,2) 

SSI (1+6, 1*3) =S1G (3,3) 

530 CONTINUE 
C 

C CALL NONLM(A,B,C,D,E,G,VR(IR34) ,VR(IR35) ,VR(IR28) , 

C 1 VR(IR29) ,VR(IR30) ,VR(IR3D ,VR(IR32) ,VR(1R33)) 

C 

C Get the nonlinear part (rotation invariant) of the matrix ESM. 

C 

C DO 441 1=1,40 
C DO 441 J=1 , 40 

C ESM ( I , J) =ESM ( I , J) +BN 1 (I ,J)-2*BN2 (I , J) +BN3 (1 ,J) 

C WRITE (6,460) 1 , J , ESM (I , J) ,BN1 (I , J) , BN2 (I , J) , BN3 (I , J) 

441 CONTINUE 

460 FORMAT (' ESM (I , J) I S: ' , 2 1 3,4F 10.3) 

C 

RETURN 

END 

C 

C Subroutine CBUPDT is to calculate the nodal forces at every 

C integration point and update stresses for that point. 

C 

SUBROUTINE CBUPDT (I I I , I L , NO , I I , JJ , KK,R, S ,T, X, Y, Z, VF , PDL , DETJ , BL , 
1 TBL,TMPBL,VFE,TL,TT,TMP, EM, EM2.PDLL, SIGMA, 

1 UPS I G ,SVT3D, SVBLD, EM4) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION X (8) , Y (8) ,Z(8) ,VF (NN0DE,5) ,PDL (1) ,BL (6,40) , 

1 TBL (40,6) ,TMPBL (6 , 40) ,VFE(40) ,A(8) ,B(8) ,C(8) , 

2 D(8) , E (8) ,G (8) ,ND (8) ,TL(6,6) ,TT (6,6) ,TMP(6,6) , 

3 EM (6,6) , EM2 (6,6) , POLL (40,1) .SIGMA (NELM, 2, 2, 2, 9) , 

4 UPSIG (NELM* 2, 2, 2, 9) ,SIG(3,3) , GRT (3,3) ,DV(3,3) , 

5 SVT3D (NELM, 2,2,2, 1 1 4) , SS 1 (3, 3) , SS2 (3 , 3) , SS3 (3, 3) , 

6 AA (3,3) ,SA (6, 1) , SD (6, 1) ,GAU (3,3) ,DGR(3,3) ,DGRT(3,3) , 

7 AAAA (6, 1) ,GRD(9) ,GR(3,3) ,DW(3,3) .SVBLD (NELM, 2, 2, 2, 19) , 

8 EM4 (NELM, 2, 2, 2, 36) 

C 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /PNTRIN/ I PI , I P2 , I P3, 1 P4, I P5, I P6, I P7, 1 P8, I P9, I PTO 
COMMON /PNTRRL/ I R 1 , I R2 , I R3, I R4, I R5, I R6, I R7 , I R8 , I R9, I R 10 , 

1 IR1 1 , 1 R 1 2 , 1 R 1 3 , IR14, I R 1 5 » IR16, IR17, IR18, 

2 IR19, IR20, IR21 , IR22, IR23, IR24, IR25, IR26, 

3 IR27.IR28.IR29, IR30, IR31, IR32, IR33, IR34, 

4 IR35.IR36.IR37, IR38, IR39, IR40, IR41, IR42, 

5 I R43 , I R44 , I R45 , I R46 , I R47 , I R48 ,1 R49 , I R50 
COMMON /UN I F BD/ I R5 1 , l R52 , 1 R53 , l R54, 1 R55 , IR56, IR57, IR58.IR59 
COMMON /UNICT/ NCONS, MODEL, ETAA,TDELT,TINIT 

COMMON /RLVEC/ VR ( 1 ) 

COMMON /INTVEC/ IPT(l) 

COMMON /GEO/ TO 

COMMON /ABDFST/ I SEC 

COMMON /CONTN/ I NS I DT, KPDT, DTLM3 

COMMON /NMBITR/ NUM 

COMMON /TMPCO/ I CTMP 

COMMON /A3/ CL1 (8) ,CM1 (8) ,CN1 (8) , CL2 (8) , CM2 (8) , CN2 (8) , 

1 CL3 (8) , CM3 (8) , CN3 (8) 
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COMMON /TMPEF/ I DO,NTEM,N ITR,NANM,CEXPN,TMMIN,TMINC,TMMAX,TMPP 

C 

I PR=0 

I F (I I .EQ. 1 .AND.JJ.EQ. 1 .AND.KK.EQ. 1) IPR=1 
DO 10 1=1,8 
A (I ) =0.0 
B ( I ) =0 . 0 
C (I) —0.0 
D ( I ) =0 . 0 
E ( I ) =0 . 0 
G ( I ) =0 . 0 
10 CONTINUE 

r 

CALL GEOM (R,S,T,TO,X,Y,Z,DETJ,A,B,C,D,E,G) 

C 

DO 30 1=1,8 
DO 30 J=1 ,5 

VFE (l*5~5+J)=VF (ND (I) ,J) 

30 CONTINUE 

f 

DO 695 1=1,9 
GRD (I) =0.0 
695 CONTINUE 

C 

DO 700 1=1,8 
K=l*5 

GRD ( 1 ) =GRD (1)+A (I) *VF E (K-4) +D ( I ) * (-CL2 ( I ) *VF E (K- 1 ) 

1 +CL1 (I) *VFE (K) ) 

GRD (2) =GRD (2) +B ( I ) *VF E (K-4) +E ( I ) * (-CL2 ( I ) *VF E (K- 1 ) 

1 +CL 1(1) *VF E (K) ) 

GRD (3) =GRD (3) +C ( I ) *VFE (K-4) +G (l ) * (-CL2 ( I ) *VFE (K- 1 ) 

1 +CL1 (I) *VFE (K) ) 

C 

GRD (4) =GRD (4) +A ( I ) *VF E (K-3) +D (I ) * (-CM2 (I ) *VFE (K-l) 

1 +CM1 (I ) *VFE (K) ) 

GRD (5) =GRD (5) +B ( I ) *VFE (K- 3 ) ■ +E (I ) * (-CM2 ( I ) *VF E (K- 1 ) 

1 +CM1 (I ) *VFE (K) ) 

GRD ( 6 ) =GRD ( 6 ) +C ( I ) *VF E (K-3) +G ( I ) * (-CM2 ( I ) *VF E (K- 1 ) 

1 +CM1 (I) *VFE (K) ) 

C 

GRD (7) =GRD (7) +A ( I ) *VFE (K-2) +D (!) * (-CN2 (I) *VF E (K- 1 ) 

1 +CN 1(1) *VF E (K) ) 

GRD ( 8 ) =GRD ( 8 ) +B ( I ) *VF E (K-2) +E (l)*(-CN2 (l) *VFE (K-l) 

1 +CN 1 (I) *VFE (K) ) 

GRD (9) =GRD (9)+C (I) *VFE (K-2)+G (I) * (-CN2 (I) *VFE (K-l) 

1 +CN 1 (I) *VFE (K) ) 

700 CONTINUE 
C 

C0MP=GRD ( 1 ) +GRD (5) +GRD (9) 

CC0MP=1 .O-COMP 
C 

DO 720 1=1,3 
DO 720 J= 1 ,3 

GR(I ,J) =GRD (l+J*3"3) 

I F (I .EQ. J) THEN 
DGR (I , J) =GR (I , J) +1 .0 
ELSE 

DGR (I , J) =GR (I , J) 

END IF 

GRT (J, I) =GR (I , J) 

DGRT (J, I) =DGR (I , J) 

720 CONTINUE 
C 

DETG=DGR (1,1) *DGR (2 , 2) *DGR (3 , 3) +DGR (2,1) *DGR (3 , 2) *DGR (1,3) 

1 +DGR (3,1) *DGR (1,2) *DGR (2,3) “DGR (3, 1) *DGR (2,2) *DGR (1,3) 

2 -DGR (2 , 1 ) *DGR (1,3) *DGR (3 , 3) -DGR ( 1 , 1 ) *DGR (3 , 2) *DGR (2 , 3) 
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D O O 


r: WRITE (6,722) DETG 

722 FORMAT (' DETG IS: ’,1F10.6) 


DO 740 1=1,3 
DO 740 J=1 ,3 

GRT ( I , J) =GR (J , I ) 

DV (I , J) =0.5* (GRT (I , J)+GR (I , J) ) 

DW ( I , J) =0 . 5* (GRT ( I , J) -GR (I , J) ) 
i: WRITE (6,741) I , J,GRT (I , J) ,DV (I , J) ,DW (I , J) 

740 CONTINUE 

741 FORMAT (' I , J,GRT,DV,DW: ' ,21 3,3F12.$) 

DO 440 1=1,3 
DO 440 J=l,3 

SIG (I , J)=UPSIG (IL, I I ,JJ,KK, l*3-3+J) 

440 CONTINUE 

450 FORMAT (* S I G ( I ,J) IS: 1 , 21 3, 1 F 1 3-5) 

C 

CALL MNU (6,40, BL) 

DO 380 1=1,8 

BL (1,1 *5-4) =A ( I ) 

BL (4, I *5~4) =B ( I ) 

BL ( 6 , l*5-4)=C (I) 

C 

BL (2, 1*5-3) “B (I) 

BL (4, 1*5-3) “A (I) 

BL(5, 1*5-3) =C (I ) 

cc 

BL (3, I *5-2) =C ( I ) 

BL (5, 1 *5-2) =B (I ) 

BL(6,I*5-2)=A(I) 

CC 

BL (1 , 1*5-1) =-D(l) *CL2(l) 

BL (2, 1 * 5 - 1 ) “-E (I) *CM 2 (I) 

BL (3, 1*5-1) =~G (I) 

BL (4 , I *5- 1 ) =-E ( I ) *CL2 ( I ) -D { I ) *CM2 (I ) 

BL (5, 1*5-1) =-G ( I ) *CM2 ( 1 ) - E ( I ) *CN2 ( I ) 

BL ( 6 , 1 *5-1) =-D (I ) *CN2 (I) -G (I) *CL2 (I) 

C 

BL (1 , 1*5) =D (I) *CL1 (I) 

BL (2, 1 *5) -E (t) *CM1 (I) 

BL(3, 1*5) =G(I)*CN1 (I) 

BL (4, I *5) “E ( I ) *CL1 (l)+D (l) *CM1 (I) 

BL (5, 1*5) “G (I ) *CM1 (l)+E (I ) *CN1 (I) 

BL ( 6 , 1*5) =D (I) *CN1 (l)+G (I) *CL1 (I) 

380 CONTINUE 
C 

CALL TRANSP(6,40,BL,TBL) 

C 

CALL MNU( 6 , 6 ,TL) 

C 

CALL ROTMTRX (R,S,X,Y,Z,TL) 

Get the rotation transformation matrix [T] . 

CALL TRANSP ( 6 , 6 ,TL,TT) 

C 

I CG 0=0 

C I F (I PR.EQ. 1) WRITE ( 6 ,*) '111 = ', III,' I SEC= I , I SEC 

IF (NUM.EQ. 1 .AND. INSIDT.EQ.O) GOTO 345 
IF ((NCONS.EQ.l) .AND. (I I I .NE.l)) THEN 
DO 453 1=1,6 
DO 453 J=l ,6 
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EM2 ( I , J) “EM4 ( I L , I I , J J , KK , I *6-6+J) 

1*53 CONTINUE 
I CGO=l 
END IF 

345 CONTINUE 

IF (ICGO.EQ.l) GOTO 988 
CALL MMT (6,6,6,TT,EM,TMP) 

CALL MMT (6 , 6 , 6 , TMP , TL , EM2) 

988 CONTINUE 

CALL MNU (6 , 40 , VR ( I R33) ) 

C 

CALL MMT (6 , 40 , 1 , BL , VF E , AAAA) 

C 

IF (ICTMP.EQ.l) THEN 

C For thermal effects calculation 

EXPNS=CEXPN*TMINC 
AAAA (1 , 1) =AAAA (1,1) -EXPNS 
AAAA (2, 1) =AAAA (2, 1) -EXPNS 
AAAA (3, 1) “AAAA (3, 1) -EXPNS 
END IF 
C 

CALL MMT (6,6,1 ,EM2, AAAA,SD) 

K=1 

C 

C sd will be the stress i ncreament 
C 

CALL TRANSP(6,40,BL,TBL) 

280 CONTINUE 
C 

c 

IF (NUM.EQ.l .AND, INSIDT.EQ.O) GOTO 875 
I EEC=0 

IF (I SEC. EQ. 1 .OR. I SEC.EQ.2) IEEC-1 
I F (NCONS.EQ. 1 .AND. I 1 1 ,EQ. 1) THEN 
I F (I PR. EQ, 1) THEN 

WRITE (6,*) 'CALL BODSUL' 

END IF 

I F (MODEL. EQ. 1) THEN 

CALL BODSUL ( I L , 1 1 , J J , KK , VR ( I R3 1 ) ,VR(IR29) ,VR(IR54) , 

1 VR ( IR55) , VR (IR 5 I) ,$D , VR ( I R 56 ) ,VR (IR57) ,AAAA) 

ELSE 

CALL WALSUL (IL, I I , JJ,KK,VR (IR31) , VR (( R29) , VR (IR54) , 

1 VR ( I R55) , VR (I R5 1 ) ,SD,VR(IR56) ,VR(IR57) ,AAAA) 

END IF 
C 

ELSE 

IF (NCONS.EQ. 1) THEN 
IF (MODEL. EQ.l) THEN 

CALL B0DS2 (I L, I I , JJ, KK, VR (I R31) ,VR(IR29) ,VR(IR54) , 

1 VR ( I R55) ,VR(IR 51 ) , SD , VR(IR56) ,VR(IR57) , AAAA) 

ELSE 

CALL WALS2(IL,I l,JJ,KK,VR(IR31) ,VR(IR29) ,VR(IR54) , 

1 VR ( I R55) , VR ( I R5 1 ) ,SD,VR(IR56) ,VR(IR57) ,AAAA) 

END IF 
END IF 
END IF 

875 CONTINUE 
C 

GAU (1 , 1) =SD (1 , 1) 

GAU (2,2) =SD (2,1) 

GAU (3. 3) “SD (3,1) 

GAU (1,2) “SD (4,1) 

GAU ( 2 , 1) =GAU (1,2) 

GAU (2, 3) “SD (5,1) 

GAU (3, 2) “GAU (2, 3) 
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GAU(3,1)=SD(6,1) 
GAU 0 ,3) =GAU (3, 1) 


DO 758 1=1,3 
DO 758 J=1 , 3 

AA (I , J) =GAU ( I ,J) 
758 CONTINUE 


4* 

DO 760 1=1,3 
DO 760 J=1 , 3 

UPS IG(IL,il ,JJ,KK, l*3-3+J)=UPSIG(IL,H,JJ,KK, l*3-3+J) 
1 +AA (I , J) 

AA (I , J)=UPSIG (I L, I I ,JJ,KK, l*3~3+J) 

r 

760 CONTINUE 


SA (1 , 1) =AA (1,1) *CCOMP 
S A (2 , 1 ) =AA (2 , 2) *CCOMP 
SA (3, 1) *AA (3*3) *CCOMP 
SA (4, 1) =AA (1,2) *CCOMP 
S A (5 , 1 ) =AA (2,3) *CCOMP 
SA (6, 1) =AA (1,3) *CCOMP 
C 
C 

CALL MMT (40,6, 1 ,TBL,SA,PDLL) 

900 CONTINUE 

DO 80 1=1,40 

PDL (I) =PDLL (1,1) 

80 CONTINUE 

90 FORMATCHERE PDL (I) IS: ' , 1 1 3, 1 F 1 2 . 7) 

C 

RETURN 

END 

C 

£ it ;’c 5’t s't ;'c A ft A A A A A A A A A A A A A A A A * 5 ': A A A A * A A A s': * A * A * * A it A A A A A ft * Vs A A A * * A A A A A A A A * A A A A * A A A A A 

C Subroutine WALS2 is the solution phase using Walker's constitutive 

C equation. It is called after the first iteration. 

C Input: 

C BL- used to find the local strain. 

C VFE- the displace increament. epsln=bl.vfe 

C SVT3D and SVBLD are the data calculated in the processing face. 

C State variable BETA (..12) are updated. 

C The derivative of the statevar i abl e STVDF and the derivative of the 
C nonlinear strain EPSND are calculated. 

c * ;fr :’c jfe j’c it * * sV it * it it it it it it it * * it it it it it i’c it it * * sV * j'c s’c * >V it * * ft * it it ft 5 ’c ft it * 5 *c * * * it * * * * it * * * 5’? it it * 5’c it * x ?c rt it i’c 

c 

SUBROUTINE WALS2 (I AA, I A, 1 8, I C, BL, VFE , SVT3D, SVBLD, BETA, SD, 

1 BDSV.EM4.AA) 

C 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT I NTEGER*8 (I -N) 

DIMENSION BL (6, 40) ,VFE (1) .SVT3D (NELM,2,2,2, 144) ,TMVEC(24) , 

1 SVBLD (NELM.2,2, 2,24) .BETA (NELM,2,2,2, 12) ,SD(6,1) , 

2 BDSV (NELM,2,2,2,6) ,EM4 (NELM,2,2,2,36) ,AA(6,1) , 

3 DBTA1 (6) ,DBTA2 (6) 

C 

COMMON /SCHALR1/ NELM.NNODE.NT 

COMMON /SCHALR2/ NEQT.NSTEP, NHBW.COEF 1 ,C0EF2,NSH0W1 .NSH0W2, 

1 NSH0W3.HRZ, ITRLM.FACTOR 

COMMON /PNTR I N/ I Pi , I P2, I P'3, I P4 , |p$, I P6 , I P7 , 1 P8 , I P9 , I P 1 0 
COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR6, IR7, "IR8, IR9, IR10, 

1 IR11, IR12.IR13, IR14, IR15, IR16, I R 1 7 . i R 1 8 , 

2 I R 1 9 » IR20, IR21 , IR22, IR23, IR24, IR25, IR26, 
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3 IR27, IR28, IR29, IR30, IR3MR32, IR33, IR3 1 *, 

4 IR35, IR36JR37.IR38, IR39, IR^O, IR41, IR42, 

5 IRi»3. IR44, IR45, IR46, IR47, IR48, IR49, IR50 
COMMON /RLVEC/ VR (1) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT,DTLAM,SGN, I PP.TROOT, ASO.SP 

COMMON /GEO/ TO 

COMMON /CONTRL/ DETMNT 

COMMON /CONTN/ I NS I DT.KPDT, DTLM1 

COMMON /WAL/ WK,WB,WN2,WN3,WN4,WN5,WN6,WN8,WN9,WN10,WNi 1 ,WRO 
COMMON /UNICT/ NCONS, MODEL, ETAA,TDELT,TIN IT 
COMMON /UNIFBD/ IR5) , I R52 , IR53, 1 R5 1 * . 1 R55 , IR56, IR57, IR58, IR59 
COMMON /WKLMT/ WAL1.WAL2 

J I PR=0 

IF ((IA.EQ.1) .AND. (IB.EQ.l) .AND. (IC.EQ.1)) IPR=1 

DO 60 1=1,24 
TMVEC (I ) =0.0 
DO 80 J=1 ,6 

TMVEC ( I ) =TMVEC ( I ) -SVT3D ( I AA , I A, I B, I C , I *6-6+J) *AA (J , 1) 

80 CONTINUE 
60 CONTINUE 

C 

DO 100 1=1,6 

SD (I , 1)=TMVEC (I) 

DBTA1 (l)=TMVEC (1+12) 

DBTA2(l)=TMVEC(l + l8) 

100 CONTINUE 
C 

C WRITE (6,*) 1 DS I GX=' , SD (1 , 1) , 1 DSY=' ,SD (2, 1) , ' DSZ=' ,SD (3, 1) 

C 

DO 120 1=1,6 

BETA ( I AA, I A, IB, 1C, I) -BETA (I AA, I A, IB, 1C, D+DBTAl (I) 

BETA ( I AA, I A, IB, 1C, 1+6) -BETA (I AA, I A, I B, I C, l+6)+DBTA2 (I) 

IF (BETA (I AA, I A, IB, 1C, I) .GT.WAL1) BETA (I AA, I A, I B, I C, I) -WAL1 
IF (BETA (I AA, I A, IB, 1C, I) .LT.-WAll) BETA (I AA, I A, I B, I C, I ) =-WAL 1 
IF (BETA (I AA, I A, IB, 1C, 1+6) .GT.WAL2) BETA ( I AA, I A, I B, I C, l+6)=WAL2 
I F (BETA (I AA, I A, IB, 1C, 1+6) .LT.-WAL1) BETA (I AA, I A, I B, I C , 1+6) =-WAL2 
120 CONTINUE 
C 

RETURN 

END 

C END (WALS2) 

C ‘ ^ ‘ _ , 

c * ** *** * ********* ***************** * ** * ** *************** ***** ************* 
Subroutine B0DS2 is the solution phase using Bodner's constitutive 
equation. It is called after the first iteration. 

I nput: 

BL- used to find the local strain. 

VFE- the displace increament. epsln=bl.vfe 

SVT3D and SVBLD are the data calculated in the processing face. 

State variable BETA (..12) are updated. 

The derivative of the statevar i able STVDF and the derivative of the 
nonlinear strain EPSND are calculated. 

k **************************************************************************** 

SUBROUTINE B0DS2 (I AA, IA, IB, 1C, BL, VFE, SVT3D, SVBLD, BETA, SD, 

1 BDSV.EM4.AA) 

C 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION BL (6,40) ,VFE(1) ,SVT3D (NELM,2,2,2, 144) .TMVEC (20) , 

1 SVBLD (NELM,2,2,2,24) .BETA (NELM,2,2,2, 12) ,SD(6,1) , 

2 BDSV (NELM,2,2,2,6) ,EM4 (NELM.2,2,2,36) ,AA(6,1) , 

3 DLBET (6) ,TMV (19) 

C 
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COMMON /SCHALR1/ NELM.NNODE.NT 

COMMON /SCHALR2/ NEQT,NSTEP,NHBW, COEF 1 , COEF2.NSHOW1 , NSHOW2 , 

1 NSHOW3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2 , I P3, I PA , I P5, I P6 , I P7 , I P8, I P9 , I P 10 
COMMON /PNTRRL/ I R 1 , I R2 , I R3 , I RA , I R5 , IR6, IR7, IR8, IR9, 1 R 10 , 

1 I R 1 1 , 1 R 1 2 , 1 R 1 3 » I R 1 A , I R 1 5 » I R 1 6 , 1 R 1 7 » ! R 1 8 , 

2 1 R 1 9 » 1R20, IR21 , IR22, IR23, IR2A, IR25, IR26, 

3 IR27, IR28, IR29 JR30, IR31. IR32, IR33, IR3A, 

A IR35, IR36, IR37, IR38, IR39. IRAO, IRAl, !RA2, 

5 IRA 3 , IRAA, IRA 5 , IRA 6 , IRA7, IRA 8 , IRA 9 , IR 50 

COMMON /RLVEC/ VR(1) 

COMMON / I NTVEC/ IPT(l) 

COMMON /ITESCH/ ROOT, DTLAM, SON, I PP.TROOT, ASO.SP 
COMMON /GEO/ TO 
COMMON /CONTRL/ DETMNT 
COMMON /CONTN/ INS I DT, KPDT, DTLM1 
COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /UN i FBD/ I R5 1 , 1 R52 , 1 R53 . 1 R5A , I R55 , 1 R5& » I R57 , 1 R58 , 1 R59 
COMMON /BOD/ DO , ZCO , ZC 1 , ZC2 , ZC3 , ZM1 , ZM2 , CA 1 , CA2 , CR1 , CR2, ZNO 
COMMON /CREEP/ I CRP , NBCRP , NBDN , CRPTM, I PON 
C 

I PR=0 

IF ((IA.EQ.1) .AND. (IB.EQ.I) .AND, (IC.EQ.l)) IPR=1 
C 

DO 80 1=1,19 
TMV ( I ) =0 .0 
TMVEC (I) =0.0 
DO 80 J=1 ,6 

TMVEC (l)=TMVEC (I) -SVT3D (I AA, I A, I B, I C, 1 *6-6+J) *AA (J , 1) 

80 CONTINUE 

DO 60 1=1,19 

TMV (l)=TMVEC (I) 

60 CONTINUE 
C 

DO 100 1=1,6 

SD (I , 1) =TMVEC (I ) 

C I F ( I PR. EQ. 1) WR I TE (6 , *) 'SD I N B0DS2 1 , SD (I , 1) 

DLBET (I ) =TMVEC (1 + 1 3) 

100 CONTINUE 
C 

DO 120 1=1,6 

BETA (I AA, 1 A, IB, 1C, I ) =BETA (I AA, 1 A, 1 B, I C, l)+DLBET(l) 

IF (BETA (IAA, I A, IB, 1C, I) .GT.ZC3) BETA '<1 AA. I A., IB, 1C, l)=ZC3 
IF (BETA (I AA, I A, IB, 1C, I) .LT.-ZC3) BETA (I AA, I A, I B, 1C, I ) =-ZC3 
120 CONTINUE 

BETA (IAA, I A, IB, 1C, 7) =BETA (I AA, I A, I B, I C, 7)+TMVEC (1 3) 

IF (BETA (IAA, I A, IB, 1C, 7) .GT.ZC1) BETA (I AA, I A, I B, I C,7) =ZC1 
IF (BETA (IAA, I A, IB, 1C, 7) .LT. (2 .0*ZC0-ZC 1) ) BETA (IAA, I A, IB, I C , 7) = 

1 2.0*ZC0-ZC1 

C 

RETURN 

END 

C END (B0DS2) 

C 

C*5'<**5’c*5 , {*************5'{********ft*Vt!fe*ytS’C#C********************#!****5%!’tS*C5'c******>'t 


C Subroutine OUTPUT is used to arrange the output data. Here C 
C D 1 ( i , j ) is the displacement matrix, where i and j are the node C 
C number and displace component number respectively. The coordinates C 
C of node i are XX (I) , YY (I) , ZZ (I) . The corresponding load can be C 
C calculated as the product of TROOT, load coefficient and the C 
C applied load (given in file dt) . C 


C****ft********5'C**********5’C**ft***#ft*ft*rtft*ft*****************5'cA****ftStftVC5'C*sV*5y* 

c 

c 

SUBROUT I N E OUTPUT (TTLD , D 1 , ANG L , TTIY , XX , YY , ZZ) 

IMPLICIT REAL*8(A-H,0-Z) 
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IMPLICIT I NTEGER *8 (I -N) 

DIMENSION D1 (NNODE ,5) , ANGL (1) ,TTLY (1) . XX (l) ,YY(1),ZZ(J) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /SCHALR2/ NEQT,NSTEP»NHBW,COEF1 , COEF2.NSHOW1 ,NSH0W2, 

1 NSHOW3.HRZ, ITRLM, FACTOR 

COMMON /RLVEC/ VR (1) 

COMMON /ITESCH/ ROOT , DTL AM * SGN , i PP , TROOT , ASO , SP 
COMMON /GEO/ TO 
COMMON /MTL/ E,EU 
COMMON /DISCT/ NDC.NDBC 

COMMON /PNTRRL/ IR1 , IR2, IR3, IR4, IR5, IR 6 , IR7, IRB, IR9, IR10, 

1 IR 1 1 , IR12, 1 R 1 3 * IR14, IRl$, IR16, IR17, tRl 8 * 

2 I R. 1 9 , 1 R 20 , 1 R 2 1 , 1 R22 , 1 R 23 , I R2 4 , 1 R25 , I R 26 » 

3 I R27 , 1 R 28 , 1 R29 , 1 R 30 » I R3U I R32 , 1 R33 , 1 R34 , 

4 I R35 , 1 R36 , 1 R37 * I R38 » I R39 . 1 RAO , I RA 1 # I R42 » 

5 IRA3, IR44, IR45, IR46, IR47, IR48, IR49, IR50 
COMMON /PNTRIN/ I PI , I P2, 1 P3» I PA, lP$, I P 6 , 1 P7, I P 8 , IP9* i RIO 
COMMON / 1 NTVEC/ IPT(1) 

COMMON /OUTVR/ NPT.NPV 
COMMON /RADS/ RR.ZL 

COMMON /CREEP/ I CRP , NBCRP, NBDN , CRPTM, 1 PON 

COMMON /UNICT/ NCONS .MODEL , ETA A , TDE LT , T I N I T 

I =NSH0W1 

NPT=1 : STRECH 

NPT=2 : PLATE 

NPT=3: PANEL 

NPT=4: CYLINDRICAL SHELL UNDER AXIAL COMPRESSION 

NPT=5: CYLINDRICAL SHELL UNDER PRESSURE 

NPT= 6 : CYLINDRICAL SHELL UNDER TORSION 

IF(NDC.EQ.O) THEN 
IF(NPT.EQ.I) THEN 
IF (ICRP.EQ.l) THEN 

WRITE (3.*) D1 (1 , 2) /20. 0*100.0, ' 1 ,TROOT*2.0/T0/20.0, ' 1 

1 CRPTM 

ELSE 

WRITE (3,*) D1 (1 ,2) / 20 , 0*100.0,' ' ,TR00T*2 .0/T0/20 .0 

END IF 
END IF 

IF (NPT.EQ.2) THEN 

DDK=3 • I A 1 59**2*E*T0**3/ 1 2 * 0 

DDK2=3 . 14159 ** 2 * 198700 .0*10**3/12.0 
IF (ICRP.EQ.l) THEN 

WRITE (3,*) Dl(l, 3) /TO,' ' ,TR00T/DDK2 , ' '.TROOT/TO,' 

1 CRPTM 

ELSE 

WRITE (3,*) 01 (1,3) /TO,' ' ,TROOT/DDK, ' 1 ,TR00T/DDK2 , * ' , 

1 TROOT/TO 

END IF 

DO 55 J=1 , NNODE 

WRITE ( 12 , 12 ) J, (D 1 (j,KK)*1000,0,KK=l,3) 

55 CONTINUE 

12 FORMAT (1 I5.3F12.5) 

23 FORMAT (7F8. 3, 1F7-1) 

END IF 

I F (NPT. EQ. 3) THEN 

WRITE (3,*) -D 1 (1,3) * 1000 . 0 , ‘ TROOT* 4, 0*1 000.0 

I F (NPV.EQ. 1) THEN 

WRITE (12, 13) D1 (8,3) *1000, 0,D1 (1 3. 3) *1000 .0, 

1 D 1 (16,3) *1000.0,D1 (21, 3) *1000, 0.TROOT*4. 0*1000.0 

13 FORMAT ('0.0' , ' * , AF 10.5, 1 F 1 1 -5) 

END IF 

END IF 
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I F (NPT.EQ.it) THEN 
I F (NPV.EQ. 1) THEN 
KKN=9 
KKO=33 
END IF 

IF (NPV.EQ. 2) THEN 
KKN=5 
KK0=1 9 
END IF 

IF (NPV.EQ. 3) THEN 
KKN=1 6 
KK0=60 
END IF 

I F (NPV.EQ.lt) THEN 
KKN=32 
KK0=60 
END IF 
WT=0 . 0 

DO 100 I®1 , KKN 
WT=WT+D 1 (1,2) 

100 CONTINUE 

WT=WT/REAL (KKN) 

W0UT=0.0 

DO 200 1=1 ,NNODE 

RDD= (D1 (1 , 1) *D1 (I , 1)+D1 (I,3)*D1 (1,3)) **0.5 
I F (I .LE .KKN) WOUT=WOUT+RDD 
IF(I.EQ.KKO) DPR=RDD 

WRITE (11,220) 1 , ( D 1 (I , J) *1000.0, J=1 ,3) , XX ( I ) , 

1 YY(I) ,ZZ(I) ,RDD*1000.0 

200 CONTINUE 

WR I TE (6 , *) 'IN OUTPUT' 

WOUT=WOUT/REAL (KKN) 

AREA-2 .0*3 . 1 4 15926535*RR*TO 

WRITE (6,*) 'IN OUTPUT',' AREA-', AREA 

WRITE (9,*) WT*2000.0, ' ' ,WOUT*1000, ' ', TROOT/AREA 

IF (ICRP.EQ.l) THEN 

WRITE (3,*) WT*2 .0/ZL, ' ' , TROOT/AREA, ' ' , CRPTM 

ELSE 

WRITE (3,*) WT*2 .0/ZL , ' '.TROOT/AREA 
END IF 

220 F0RMAT(1 I5.6F10.6, 1F12.3) 

WRITE (11,*) '*' 

END IF 

IF (NPT.EQ.5) THEN 
TEMP-0.0 

I F (NPV.EQ. 1. OR. NPV.EQ. 3) THEN 
DO ItlO 1=1,7 

TEMP-TEMP+D1 (1,2) 
it 1 0 CONTINUE 

TEMP-TEMP* 1000. 0/7.0 

WRITE (9,1*25) (D1 (I ,2) *1000. 0,1 = 1, 7) .TEMP.TROOT, 

1 TR00T*RR**3* 1 0.92/1 98700 . 0/T0**3 

1*25 FORMAT (7 F 7 . 4 » 1 F 7 • 4 , 2 F 1 1 ... 6) 

WRITE (11,*) TEMP,' * ' ,TROOT, TR00T*RR**3*10. 92/198700. /T0**3 
WR I TE ( 1 1 , 1*27) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 . 5"RR) *1000.0,1=8,11) 

WRITE (1 1 ,1*26) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 , 5"RR) *1000.0,1 = 12,18) 

WR I TE ( 1 1 , 1*2 7) ( ( (XX (1 ) **2+ZZ ( I ) **2) **0 . 5"RR) *1000.0,1 = 19,22) 

WR I TE (1 1 , 1*26) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 .5-RR) *1000.0, I =23,29) 

WRITE (11,427) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 . 5"RR) *1000.0, 1=30 , 33) 

WR I TE ( 1 1 , 426) ( ( (XX (I ) **2+ZZ (I ) **2) **0 . 5"RR) *1000.0,1=34,40) 

IF (NPV.EQ. 3) THEN 

WRITE (1 1,427) ( ( (XX (I) **2+ZZ (I) **2) **0.5-RR) *1000.0, 1=41,44) 
WR I TE ( 1 1 , 426) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 . 5~RR) *1000.0,1=45,51) 
WR I TE (3 , *) -((XX (48) **2+ZZ (48) **2) **0 . 5~RR) *1000.0, TROOT , 

1 TR00T*RR**3*1 0.92/ 198700. /T0**3 

ELSE 
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IF (ICRP.EQ.l) THEN 

WR I TE (3 , *) - ( (XX (37) **2+ZZ (37) **2) **0 . 5-RR) * 1 000 . 0 , TROOT , 

1 CRPTM 

ELSE 

WR I TE (3 , *) - ( (XX (37) **2+ZZ (37) **2) **0 . 5-RR) *1000.0, TROOT , 

1 TR00T*RR**3* 10.92/1 98700 . /T0**3 

END IF 
END IF 
WRITE (11,*) 

426 FORMAT (7F 10.7) 

427 FORMAT (IF 10. 7, 1 * , IF 10-7. * * , 1 F 10.7, 

1 ’ MF10.7) 

ELSE 

DO 411 1=1,9 

TEMP=TEMP+D1 (1,2) 

411 CONTINUE 

TEMP=TEMP* 1000. 0/9.0 

WRITE (9,426) (D 1 (1 ,2) *1000.0, 1 = 1 ,9) 

WRITE (9,432) TEMP, TROOT, 

1 TR00T*RR**3* 10.92/198700. 0/T0**3 

429 FORMAT (9F8. 4) 

432 FORMAT (3F 12.6) 

WRITE (11,*) TEMP, ' * 1 , TROOT, TR00T*RR**3*10. 92/198700. /T0**3 
WR I TE ( 1 1 , 424) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 . 5~RR) *1000.0,1 = 10,14) 
WR I TE ( 1 1 , 423) ( ( (XX ( I ) **2+ZZ (I ) **2) **0 . 5"RR) * 1000.0,1=15,23) 
WRITE (11,424) (( (XX (I) **2+ZZ(l)**2)**0. 5-RR) *1000.0, 1=24,28) 

WRITE (11, 423) ( ( (XX ( I ) **2+ZZ ( I ) **2) **0 . 5~RR) *1000.0,1 =29 , 37) 
WR I TE ( 11 , 424) ( ( (XX ( I ) ** 2+ZZ ( I ) **2) **0 . 5~RR) *1000.0,1=38,42) 
WRITE (1 1,423) ( ( (XX ( I ) **2 +ZZ ( I ) **2) **0 . 5"RR) *1000.0, 1=43,51) 
WRITE (11,*) 

423 FORMAT (9F8. 5) 

424 FORMAT (5F 10.7) 

WR I TE (3 , *) - ( (XX (47) **2+ZZ (47) **2) **0 . 5~RR) *1000.0, TROOT , 

1 TROOT *RR**3*1 0.92/1 98700 . /T0**3 

END IF 
END IF 
ELSE 

I F (NPT.EQ. 1) THEN 

WRITE (3,*) ' ' ,D1 (1,2) /20. 0*100.0,' ' .TTLD/T0/20 .0 

END IF 

IF (NPT.EQ. 2) THEN 
DDK=3 • 1 4 1 59**2*E*TO**3/ 12.0 

WRITE (3,*) ' *,01(1,3) /TO , » ' ,TTLD*2. 0/DDK 

END IF 

IF (NPT.EQ. 6) THEN 
T0R=0 .0 

DO 600 1=1 ,NDBC,2 

TOR=TOR+RR* (-TTLY ( I ) *S I N (ANGL (I ) ) +TTLY ( 1 + 1) *COS (ANGL ( 1 + 1) ) ) 
600 CONTINUE 

WRITE (3,*) TROOT,' ' ,TOR 

DO 400 1=1 ,NNODE 

WRITE (11,*) I,’ (XX(I)**2+ZZ(I)**2)**0.5-RR 

400 CONTINUE 

WRITE (11,*) '*' 

END IF 
END IF 
RETURN 
END 

Subroutine UPDT is to update some variables when the 
equilibrium requirement is satisfied, 

SUBROUTINE UPDT(ITYPE, I I D , XX , YY , ZZ , DLD I NC , D 1 , ACMD IS, XX 1 , 

1 YYl ,ZZ1 , DELTA, UPS I G, SIGMA, DLT INC, DLTTMP, 

2 BETA, UPBET,GCL1,GCL2,GCL3,UCL1,UCL2,UCL3, ANGL) 
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IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8 (l-N) 

DIMENSION I I D (NNODE ,5) 

DIMENSION XX(1) ,YY(1) ,ZZ(l) ,01 (NNODE, 5) ,ACMDIS(1) ,XX1 (1) , 

1 YY1 (1) ,ZZ1 (1) .DELTA (1) , UPS I G (NELM, 2 , 2 , 2 , 9) , 

2 SIGMA (NELM, 2, 2, 2, 9) , DLT I NC (1) , DLTTMP (1) , 

3 BETA (NELM, 2, 2, 2, 12) .UPBET (NELM, 2, 2, 2, 12) , 

GCL1 (NNODE, 3) , GCL2 (NNODE , 3) ,GCL3 (NNODE , 3) , 

5 UCL1 (NNODE, 3) , UCL2 (NNODE , 3) , UCL3 (NNODE , 3) , ANGL (1) 

COMMON /SCHALR1/ NELM, NNODE , NT 

COMMON /SCHALR2/ N EQT , NSTEP , NHBW, COE F 1 , COE F 2 , NSHOW 1 jNSHOW2, 

1 NSHOW3.HRZ, ITRLM, FACTOR 

COMMON /PNTRIN/ I PI , I P2, I P3, 1 P**, I P5, I P6., I P7, 1 P8, I P9, 1 P1.0 
COMMON /PNTRRL/ IR1 , IR2, IR3, IRA, IR5, IR6, IR7, IRS, IR9, IR10, 

1 I R 1 1 , IR12, IR13, I R 1 4 , IR15. IR16, IR17» IR18, 

2 1 R 1 9 , I R20, 1 R21 , I R22 , I R23, 1 R24, 1 R25» I R26, 

3 IR27, IR28, IR29, IR30, IR3UR32, IR33, IR3 1 *, 

1* IR35. IR36, IR37. IR 38 , IR39. IR^O, IR4l,IR42, 

5 I R43. IR4J», I R45 , 1 R46 , IR47, 1.R48, IR1*9. IR50 

COMMON /UN I F BD/ IR5MR52, IR53. 1 R5A , I R55 , 1 R56 , 1 R57 . 1 R58 , 1 R59 
COMMON /DIRCS/ IR60, IR6l , IR62, I R6 3 , IR64 , IR65 
COMMON /DISCT/ NDC.NDBC 

COMMON /UNICT/ NCONS, MODEL, ETAA,TDELT,TINIT 
COMMON /RLVEC/ VR(1) 

COMMON / 1 NTVEC/ I PT ( 1 ) 

COMMON /ITESCH/ ROOT , DTLAM , SGN , I PP , TROOT , ASO , SP 
COMMON /GEO/ TO 
COMMON /OUTVR/ NPT.NPV 
COMMON /CONTN/ I NS I DT, KPDT, DTLMI 
C 

ND=NEQT 

DO 689 1=1, NNODE 
XXI (l)=XX(l) 

YY1 ( I ) =YY (I) 

ZZ1 (l)=ZZ(l) 

DO 688 J=1 ,3 

UCL1 (I , J) =GCL1 (I ,J) 

UCL2 (I , J)=GCL2 (I ,J) 

UCL3 (I , J)=GCL3 (I >«J) 

688 CONTINUE 

WRITE (6,691) I ,XX1 (I) , YY1 (I) ,ZZ1 (I) 

691 FORMAT ( 1 COOR: ' , 1 1 3. 3* 10.6) 

689 CONTINUE 
C 

DO 269 1=1, NELM 
DO 269 J=1 , 2 
DO 269 K=1 , 2 
DO 269 M=1 , 2 
DO 269 N*1,9 

SIGMA (I , J,K,M,N) =UPSIG (I , J,K,M,N) 

269 CONTINUE 
C 
C 

IF (NCONS. EQ.l) THEN 
C 

DO 169 1=1, NELM 
DO 169 J=1 , 2 
DO 169 K=1 , 2 
DO I 69 M=1 , 2 
DO 169 N=1 , 1 2 

UPBET(I , J,K,M,N) =BETA (I , J,K,M,N) 

169 CONTINUE 
END IF 

IF (ITYPE.EQ.2) GOTO 800 
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DO 669 1 = 1 , ND 

DLTTMP ( I ) =DELTA ( I ) 

ACMD I S ( I ) =ACMD 1 S ( I ) +DLT I NC ( I ) 

669 CONTINUE 
C 

K=1 

DO 589 1=1 ,NN0DE 

DO 589 J=1 ,5 

IF (I I D (1 ,J) . EQ.O) THEN 
D 1 (I ,J)=ACMDIS(K) 

K=K+1 
END IF 
589 CONTINUE 
C 

IF(NPT.EQ.6) THEN 
DO 620 1=1 ,NDBC 

ANGL (I) =ANGL (O+DTLMl 
620 CONTINUE 
END IF 

800 CONTINUE 
RETURN 
END 

Subroutine DISBN is used to calculate the displacement increment 
in displacement boundary value problem for cylindrical shells. 

SUBROUTINE D I SBN (ADVC , ANGL) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGERS (I -N) 

DIMENSION ADVC (1) , ANGL (1) 

COMMON /DISCT/ NDC.NDBC 
COMMON /D I SVC/ I R66, I R 67 , I R68, I R 69 
COMMON /RLVEC/ VR (1) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /OUTVR/ NPT.NPV 
COMMON /RADS/ RR,ZL 
NPT=1 : STRECH 
NPT=2 : PLATE 
NPT=3: PANEL 

NPT=4: CYLINDRICAL SHELL UNDER AXIAL COMPRESSION 

NPT=5: CYLINDRICAL SHELL UNDER PRESSURE 

NPT=6: CYLINDRICAL SHELL UNDER TORSION 

IF (NPT.EQ.1 .0R.NPT.EQ.2) THEN 

DO 10 1=1, NDBC 
ADVC (1)=1.0 
10 CONTINUE 
END IF 

IF(NPT.EQ.6) THEN 
WRITE (6,*) 'RR=',RR 
DO 30 1=1, NDBC 

WRITE (6,*) l,' ANGLE' , ANGL (I) 

30 CONTINUE 

K=1 

DO 20 1=1, NDBC, 2 

ADVC (K) =-RR*S I N (ANGL ( I ) ) 

ADVC (K+ 1 ) =RR*COS (ANGL ( 1 ) ) 

C WRITE (6,*) 1 ADVC1 = ' , ADVC (K) , 1 ADVC2= 1 , ADVC (K+l ) 

K=K+2 

20 CONTINUE 

END IF 
RETURN 
END 
C 

C Subroutine NTCRP is for the calculation of creep buckling. 


G-a 
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Newton-Raphson 1 s iteration scheme is employed in the equilibrium 
iterations. 

SUBROUTINE NTCRP (INUM, I EL, I D, I I D , L , MAXA , LD . XX, YY , ZZ, DLOADT, D , 

1 PLD,FRC0,DD,DLDINC,VTEMP,VF,D1 , VFE,DDD, 

AM, PD,P, A.TDLD.H I S I NC , ACMD I S, FRC I NC, 

XX 1 , YY1 , ZZ1 .DELTA, UPS I G, S I GMA, DLTI NC , DLTTMP, 

ST1 FFN,EXLVC,BETA,UPBET,ACTFRC,GCL1 , 

GCL2,GCL3,UCL1 , UCL2, UCL3, ADC, ADD,AD, ADVC.TLTY, 

TY1 ,TY2, ANGL.DBVC) 

IMPLICIT REAL*8(A-H,0-Z) 

IMPLICIT I NTEGER*8 (I -N) 

DIMENSION IEL(NELM,8) , ID(1) , I I D (NNODE ,5) ,L(1) ,MAXA(1) , LD (1) , 

XX (1) ,YY (1) ,ZZ (1) , DD (NNODE ,5) ,0(1) ,PLD(1) .DLOADT (1) , 
DLDINC(l) ,VTEMP(1) ,VF (NNODE, 5) ,D1 (NNODE ,5) »Vf E (NT, 1) , 
DDD(l) , VRT (L) , A (NEQT.NEQT) , AM (40 , LO) ,PD (1) ,P1 (1) , 

TDLD(l) , H I S I NC (1) , ACMD I S (1) , FRC I NC (1) ,XX1 (1) ,YY1 (1) , 

ZZ1 (1) , DELTA (1) ,FRC0(1) .UPSIG (NELM, 2, 2, 2, 9) ,ACTFRC(1) , 
SIGMA (NELM, 2, 2, 2, 9) .DLTINC(l) , DLTTMP (1) ,COEEQ(5) , 

DEFVRT (A) ,STI FFN (NT, NT) . ETT (4) ,EXLVC(1) ,DBVC(1) , 

BETA (N.ELM,2,2,2, 12) , UPBET (NELM, 2, 2, 2, 12) ,GCL1 (NNODE, 3) . 
GCL2 (NNODE, 3) ,GCL3 (NNODE , 3) ,UCL1 (NNODE, 3) , UCL2 (NNODE, 3) , 
UCL3(NNODE,3) , ADC (NDBC.NDBC) , ADD (NDBC.NEQT) , 

AD (NEQT.NDBC) ,ADVC(1) , TLTY ( 1 ) , TY 1 (1) ,TY2 (1) , ANGL (1) 

COMMON /SCHALR1/ NELM, NNODE, NT 

COMMON /SCHALR2/ NEQT, NSTEP, NHBW , COE F 1 , COE F 2 , NSHOW 1 , NSH0W2 , 

NSHOW3, HRZ, ITRLM, FACTOR 
COMMON /RLVEC/ VR (1) 

COMMON / 1 NTVEC/ IPT(l) 

COMMON /PNTRIN/ I PI , I P2, 1 P3, 1 P4, I P5, IP6, I P7, I P8, I P9, 1 P10 
COMMON /PNTRRL/ IR1 , IR2, IR3, 1 R4 , IR5, IR6, IR7, IR8, IR9, 1 RIO, 

I R 1 1 , 1 R 1 2 , 1 R 1 3 » I Rl4, 1 R 1 5 * IR16, IR17, IR18, 

1 R 1 9 , I R20 , 1 R2 1 , I R22 , I R23 , I R2A , I R25 , IR26, 

IR27, IR28, IR29, IR30, IR31 , I R32, IR33, IR'34, 

I R 35 , 1 R36 , 1 R 37 » 1R38, IR39, IR40, 1 R4l , 1 R42 , 

I R43 , 1 R44 , 1 R45 , 1 , I R47 , 1 R^ 8 , 1 R49 , 1 R 50 
COMMON /UNIFBD/ IR51 , IR52. I R53. 1R54, 1R55. I R56, I R$7 . IR58, IR59 
COMMON /DIRCS/ IR60, IR6l , I R62, IR 63 , I R64 , IR 65 
COMMON /D I SVC/ IR66, IR 67 , IR68, IR69 
COMMON /DISV1/ IR70, IR71 , IR72, IR73, I R74 , IR75 
COMMON /DISCT/ NDC.NDBC 

COMMON /UNICT/ NCONS, MODEL, ETAA.TDELT.TINIT 
COMMON /ITESCH/ ROOT , DTL AM , SGN , I PP , TROOT , ASO , SP 
COMMON /GEO/ TO 
COMMON /CNTRL/ DETMNT 
COMMON /CONTN/ I NS I DT, KPDT.DTLMl 
COMMON /ABDFST/ I SEC 
COMMON /MTL/ E,EU 
COMMON /SQ/ SQQ 
COMMON /BRLIM/ LIM 
COMMON /NMBITR/ NUM 
COMMON /OUTVR/ NPT.NPV 
COMMON /CRPC/ CRPC1 ,CRPC2 
COMMON /CREEP/ I CRP , NBCRP , NBDN , CRPTM, I PON 
COMMON /CNTR/ ICNTR 
COMMON /TMPCO/ I CTMP 
C 
C 

I CTMP=0 

C (The switch to the effects of the change of temperature is off) 

I CNTR= I CNTR+1 
RTL=0 .0 
L I M=0 
VLSI =0.0 
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VLS2=0.0 

CALL I N I T (VR (I R 1) ,VR(IR2) ,VR(IR3) ,VR(IRi*3) ,VR(IRU) , VR ( 1 Ri»5) , 

1 VR(IR 60 ) , VR (I R61) ,VR(IR62) ,VR(IR63) ,VR(IR61») ,VR(IR65) , 

2 VR(IRi»7) , VR (IR20) .VR (IR51) ,VR(IR58)) 

r ■ 

WRITE (6,*) 'NUMBER:', I NUM 
ND=NEQT 

IF (ICRP.EQ.l) THEN 
NBDN=NBDN+1 
END IF 

Q 

C Begin iteration 

C 

I I 1 = 1 

c 

CALL MNU (NN0DE.5. VF) 

DO 200 1=1 , NT 

DLDINC (l)=DL0ADT CD- 
200 CONTINUE 

DO 195 1=1 .ND 
TDLD (I) =0 .0 
HISINC (l)=0.0 
195 CONTINUE 
C 

210 FORMAT (' I , LDINC,LOADT,PLD I S ' , 1 1 3, 3F8 . 3) 

C 

579 CONTINUE 

Form the global stiffness matrix* 

CALL ASSMBL (I I I , I PT (I PI) , IPT (IP2) , I PT (IP3) . I PT (IPl») , I PT (I P5) , 

1 I PT ( I P9) , VR ( I R 1 ) , VR ( I R2) ,VR(IR3) ,VR(IR6) ,VR(IR8) , 

2 VR ( I R 12) , VR ( I R1 4) , 

3 VR ( I R 1 5) . VR { I R 1 6) , VR ( I R 1 9) , 

4 VR (IR21) , VR ( I R23) . VR ( I R24) , VR ( I R 1 9> . VR (IRJ»1) ,VR(IR50) , 

5 VR(IR 52 ) , VR ( I R66) ,VR(IR67) , VR ( I R68) ,VR(IR74)) 

C 

C 

I CDD=1 

WRITE (6,*) 'ASSMBL CALLED' 

IF (I I I . GT.2) GOTO 577 
IF (NDC.EQ.l) THEN 
CALL DISBN (VR(IR69) ,VR(IR75)) 

DO 570 1=1, ND 

C WRITE (6,*) I , (AD (I ,K) ,K=1 ,NDBC) 

DDD (I) =0.0 
DO 570 J=1,NDBC 

DDD ( I ) =DDD ( I ) +AD ( I , J) *ADVC (J) 

570 CONTINUE 

533 FORMAT (1 1 3*6F9*3) 

DO 572 1=1, ND 

DDD (l)=D (I) -DDD (I) 

572 CONTINUE 
END IF 

IF (NDC.EQ.O) THEN 
DO 573 1=1, ND 
DDD (D -D (D 

573 CONTINUE 
END IF 

16 F ORMAT ( ' D ( I ) AND DDD (I) : * , 1 1 3.2F14.5) 

C 

577 CONTINUE 

WRITE (6,36) III 

36 FORMAT ('THIS IS THE ITERATION ',113) 

IF (I I I .EQ. ITRLM) THEN 

WRITE (6,*) 'ITERATION LIMIT REACHED. STOP.' 
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STOP 
END IF 

r- 

IF (I I I .EQ.l) THEN 

r V 

DO 755 1=1, ND 
VTEMP (I ) =0.0 
DO 755 J=1,ND 

VTEMP ( I ) = VTEMP ( I ) +ST I F FN ( I , J) *TDLD (J) 

755 CONTINUE 
C 

ASL=0 .0 
DO 857 1=1, ND 

ASL=ASL+VTEMP (I) *TDLD (I) 

C WRITE (6,*) I , 1 TDLD=' ,TDLD (I) 

857 CONTINUE 

WRITE (6,*) 'ASL '.ASL 
C 

WRITE (6,*) l TDELT= l ,TDELT 
WRITE (6,*) 1 DETMNT=' .DETMNT 
IF (ASL. LT. 0.0) THEN 
WRITE (6,*) 'CHANGED SIGN OF FAC' 

END IF 

IF (DETMNT.LT. 0.0) WRITE (6,*) 'NEGATIVE DETERMINE 
DO 550 I =1 , ND 
DLTTMP (I ) =0 .0 
DELTA (I) =0.0 
VTEMP ( I ) =0 .0 
FRCINC (1 ) =0.0 
550 CONTINUE 
END IF 
C 

WRITE (6,*) '||| = ', II I 

C 

625 CONTINUE 

DO 635 1=1, ND 
DLT I NC ( I ) =0 .0 
DO 63 k J=1 ,ND 

DLT INC (I) =DLTINC (l)+A (I ,J)*EXLVC (J) 

63^ CONTINUE 

IF (I I I .GT.l) DLT I NC ( I ) =DLT I NC ( I ) *CRPC 1 
DELTA ( I ) =D LTTMP ( I ) +DLT I NC ( I ) 

635 CONTINUE 
C 

IF (III .EQ.l) THEN 

WRITE (6,*) 'FIRST ITERATION OF STEP ' ,NUM 
END IF 
I =NEQT 

WRITE (6,*) 'CURRENT ROOT ' .ROOT 
WRITE (6,*) 'TDLD (25) ’ ,TDLD (I ) 

WRITE (6,*) I,' ROOT*TDLD ' , ROOT*TDLD (I) 

WRITE (6,*) I,' FRCINC ’.FRCINC(I) 

WR I TE (6 , *) I,' HISINC ' ,HI S INC { I ) 

WRITE (6,*) I,' DLT INC '.DLTINC(I) 

WRITE (6,*) I,' DELTA 1 .DELTA (I) 

C 
C 

K=1 
KK=1 

DO 580 1=1 ,NNODE 
DO 580 J=1 ,5 

IF (I ID(I.J) . EQ.O) THEN 
VF (I , J) =DLTI NC (K) 

DD ( I ,J)=DLTINC (K) 

K=K+1 
END IF 
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380 CONTINUE 


DO 901 1=1 ,NNODE 
DO 901 J=1 ,5 
VFE(l*5-5+J.1)“VF (I ,J) 

901 CONTINUE 

302 FORMAT (' I ,VFE (I) IS: 1 ,21 2, IF 12.6) 


T I NC=1 .0 

DO 900 1=1 ,NNODE 

XX (I) =XX (l)+DD (1,1) 

YY ( I ) =YY ( I ) +DD (1,2) 

ZZ (I) =ZZ (I ) +DD (1,3) 

TMP=0.0 
DO 903 J=1 ,3 

GCL3 0 ,J)=GCL3(I , J)+TINC* (-GCL2 (I ,J)*DD(I ,1»)+GCL1 (I , J) *DD (1 ,5) ) 
TMP=TMP+GCL3(I ,J)*GCL3(I .J) 

903 CONTINUE 

TMP=TMP**0.5 
DO 902 J=1 ,3 
GCL3 0 ,J)=GCL3(I , J) /THP 
902 CONTINUE 

C WRITE (6,267) I , XX (I ) , YY (I ) ,11 (I) 

900 CONTINUE 

C 

C Calculate new directional cosines for all the nodes of elements. 

C 

CALL CNND (VR (IR60) ,VR(IR6l) ,VR(IR62)) 

Calculate internal forces 

CALL INTFRC (I | I , IPT(IPl) , VR ( I R 1 ) ,VR(|R2) ,VR(IR3) , 

1 VR (.IR 14) , VR (IR22) , VR ( I R28) ,VR(IR9)) 


DO 500 1=1, NT 
DO 500 M=1 ,ND 

IF (I .EQ.L(M)) THEN 

FRC I NC (H) = (PLD ( I ) -FRCO (M) ) 

ACTFRC (M)=PLD (I) 

C WRITE (6,*) M, 1 PLD=',PLD(I) ,' FCO=' , FRCO (M) , ' F I C=' , FRCI NC (M) 
END IF 
500 CONTINUE 
C 

DO 5^9 1=1, ND 

EXLVC (I) =-FRC I NC (I ) 

C WRITE (6,*) M, ' FCO=' , FRCO ( I ) , 1 F I C=' , FRCI NC (I) 

C 1 , 'ACTF=' , ACTFRC (I) 

5^9 CONTINUE 
C 

I SWTCH=0 
I SEC=I SEC+1 

IF MSEC. GT. 10) I SEC=10 
C 

DO 665 1=1, ND 

DLTTMP (I) =DELTA (I) 

C WRITE (6,*) 'DELTA AFTER 1 , DELTA (I) 

ACMD I S (I ) =ACMD I S (l)+DLTI NC (I ) 

C WRITE (6,*) I,' ACMD I S 1 , ACMD I S (I) 

665 CONTINUE 

C 

c 

K=1 

DO 585 1=1 ,NNODE 
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DO 585 J=1 .5 

I F ( I I D ( I , J) . EQ.O) THEN 
Dl(l ,J)=ACMDIS(K) 
K=K+1 
END IF 
CONTINUE 


C Check whether equilibrium requirement is satisfied. 

C 

CALL CRITR3 (I I I ,ND,VR(|R8) ,VR(IR42) ,VR(IR59) ,VR (1 R1 7) , 

1 VLINIT, ICNC1»VALS) 

WRITE (6,*) ' VL I N IT=* .VLINIT 
C IF (ICNC1.EQ.O) THEN 

C IF(III.EQ.l) VLS 1=VALS 

C I F ( I I I . EQ . 2) VLS2=VALS 

C IF (I I I . GT . 2) THEN 

C I F (VALS.GT.VLS1 . AND . VALS .GT . VLS2) THEN 

C WRITE (6,*) 1 BREAK® 1 , L I M 

C DTLMl=DTLMl/2.0 

C L I M=L I M+l 

C IF (LIM.EQ.20) THEN 

C WRITE (6,*) 'Break limit reached, stop' 

C STOP 

C END IF 

C GOTO 1000 

C ELSE 

C VLS 1=VLS2 

C VLS2=VALS 

C L I M=0 

C END IF 

C END IF 

C END IF 

C 

IF ( ( ! CONCL . EQ. 1) .OR. ( I CNC 1 . EQ. 1) ) THEN 
C IF (I I I .LT. 3. AND.NUM.LT. 24) DTLM1=DTLM1*SQQ 

DTLM1=DTLM1*SQQ 

IF (I 1 I . GE .8. AND . I I I .LT. 10) DTLM1=DTLM1/1 . 1 
IF (I I I .GE. 10. AND. I I I .LT. 15) DTLM1=DTLM1/1 .2 
IF (I I I .GE. 15) DTLM1=DTLM1/1 .0 

WRITE (6,*) 'FIN VAL OF 111 = ', III,' NDTLM1 = ' , DTLM1 
CRPTM=CRPTM+TDE LT 
C 

C Write output data 

C 

CALL OUTPUT (TTLD.VR (I R15) ,VR(IR75) ,VR(IR71) , VR ( I R 1 ) ,VR(IR2) , 
1 VR ( I R3) ) 

C 

ITYPE=1 

C Update some variables. • 

CALL UPDT ( I TYPE , I PT ( I P3) ,VR(IR1) ,VR(IR2) ,VR(IR3) ,VR(IR12) , 

1 VR ( I R15) ,VR (IR27) ,VR(IR43) , VR (I R44) ,VR(IR45) , 

2 VR (I R46) ,VR(IR47) ,VR(IR20) ,VR(IR48) ,VR(IR49) , 

3 VR (IR 51 ) , VR ( I R 58 ) , VR ( I R60) , VR (IR6l) ,VR(IR62) , 

4 VR (IR 63 ) , VR (IR64) ,VR(IR65) ,VR(IR75)) 

c 

ELSE 

111=11 1+1 
I CDD= I CDD+1 
GOTO 577 
END IF 

670 CONTINUE 
C 

DO 555 1=1, ND 
DO 555 J=1,ND 

VTEMP ( I ) =VTEMP ( I ) +ST I F FN ( I , J) *DELTA ( J) 

555 CONTINUE 
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ASL0P=0.0 
DO 557 1=1, ND 

ASLOP=ASLOP+VTEMP (I) *DELTA (I) 

557 CONTINUE 

ASL0P=ASL0P/ABS (ASLOP) 

IF (KPDT.EQ.NUM) THEN 

CALL WTCDT (VR (IR27) ,VR(IR20) ,VR(IRl*3) ,VR(IRl*i.) , 

1 VR ( | Ri*5) , VR ( I R 1 ) , VR ( I R2) , VR ( I R3) . 

1 VR (IR47) , VR ( IR10) , VR ( I R5 1 ) ,VR(IR58) ,VR(IR60) , 

3 VR (IR61) ,VR(IR62) ,VR(IR15) ,VR(IR71) ,VR(IR75)) 

END IF 
1000 CONTINUE 
RETURN 
END 


Subroutine I nit is used to initiate some variables 

SUBROUTINE I N IT (XX, YY, ZZ, XXI , YY1 ,ZZ1 ,GCL1 , GCL2.GCL3, 

1 UCL1 ,UCL2,UCL3,UPSIG, SIGMA, BETA, UPBET) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT I NTEGER*8 ( I -N) 

DIMENSION XX (1) , YY ( 1 ) , ZZ (1) ,XX1 (1) ,YY1 (1) ,ZZ1 (1) , 

1 UPS I G (N E LM , 2 , 2 , 2 , 9) , S I GMA (NELM, 2, 2, 2, 9) , 

2 BETA (N ELM, 2, 2, 2, 12) , UPBET (NELM.2,2,2, 12) , 

3 GCL 1 (NN0DE.3) ,GCL2 (NNODE , 3) , GCL3 (NN0DE.3) , 

k UCL 1 (NNODE , 3) , UCL2 (NNODE , 3) , UCL3 (NNODE , 3) 

COMMON /SCHALR1/ NELM, NNODE, NT 


DO 687 1=1, NNODE 
XX (I ) =XX1 (I) 

YY (I) =YY1 (I) 

ZZ(I)=ZZ1 (I) 

DO 686 J-1,3 

GCL 1(1 , J)=UCL1 (I ,J) 

GCL2 (I , J)=UCL2 (I , J) 

GCL3(I,J) =UCL3(I,J) 

686 CONTINUE 

687 CONTINUE 

DO 21*9 1 = 1, NELM 
DO 249 J-1,2 
DO 21*9 K= 1,2 
DO 21*9 M= 1 , 2 
DO 21*9 N-1,9 

UPSIG (I , J,K,M,N) =S I GMA ( I ,J,K,M,N) 

21*9 CONTINUE 

DO 161* |=l, NELM 
DO 16 1* J=1 ,2 
DO 161* K=1 , 2 
DO 161* M=1 , 2 
DO 161* N= 1,12 

BETA ( I , J , K , M, N) =UPBET (I , J,K,M,N) 

161* CONTINUE 

RETURN 

END 

Subroutine REDC eliminates the redundant elements of a vector, 

SUBROUTINE REDC (L,D , DLD I NC) 

IMPLICIT REAL*8 (A-H.O-Z) 

IMPLICIT INTEGER*8(I-N) 

DIMENSION L(l) , D (1) , DLD INC (1) 

COMMON /SCHALR1/ NELM, NNODE , NT 
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c 


DO 500 1=1, NT 
DO 500 M=1 , IDF 

IF (I .EQ.L (M) ) THEN 
D (M)=DLDINC (!) 
END IF 

500 CONTINUE 

C 

RETURN 
END 

(END REDC) 
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